| commit | author | age | ||
| 5cb5f7 | 1 | ;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2013 Johan Andersson | |
| 4 | ||
| 5 | ;; Author: Johan Andersson <johan.rejeep@gmail.com> | |
| 6 | ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com> | |
| 7 | ;; Version: 0.20.0 | |
| 8 | ;; Package-Version: 20180106.922 | |
| 9 | ;; Keywords: files, directories | |
| 10 | ;; URL: http://github.com/rejeep/f.el | |
| 11 | ;; Package-Requires: ((s "1.7.0") (dash "2.2.0")) | |
| 12 | ||
| 13 | ;; This file is NOT part of GNU Emacs. | |
| 14 | ||
| 15 | ;;; License: | |
| 16 | ||
| 17 | ;; This program is free software; you can redistribute it and/or modify | |
| 18 | ;; it under the terms of the GNU General Public License as published by | |
| 19 | ;; the Free Software Foundation; either version 3, or (at your option) | |
| 20 | ;; any later version. | |
| 21 | ||
| 22 | ;; This program is distributed in the hope that it will be useful, | |
| 23 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 24 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 25 | ;; GNU General Public License for more details. | |
| 26 | ||
| 27 | ;; You should have received a copy of the GNU General Public License | |
| 28 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 29 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
| 30 | ;; Boston, MA 02110-1301, USA. | |
| 31 | ||
| 32 | ;;; Code: | |
| 33 | ||
| 34 | ||
| 35 | ||
| 36 | (require 's) | |
| 37 | (require 'dash) | |
| 38 | ||
| 39 | (put 'f-guard-error 'error-conditions '(error f-guard-error)) | |
| 40 | (put 'f-guard-error 'error-message "Destructive operation outside sandbox") | |
| 41 | ||
| 42 | (defvar f--guard-paths nil | |
| 43 | "List of allowed paths to modify when guarded. | |
| 44 | ||
| 45 | Do not modify this variable.") | |
| 46 | ||
| 47 | (defmacro f--destructive (path &rest body) | |
| 48 | "If PATH is allowed to be modified, yield BODY. | |
| 49 | ||
| 50 | If PATH is not allowed to be modified, throw error." | |
| 51 | (declare (indent 1)) | |
| 52 | `(if f--guard-paths | |
| 53 | (if (--any? (or (f-same? it ,path) | |
| 54 | (f-ancestor-of? it ,path)) f--guard-paths) | |
| 55 | (progn ,@body) | |
| 56 | (signal 'f-guard-error (list ,path f--guard-paths))) | |
| 57 | ,@body)) | |
| 58 | ||
| 59 | ||
| 60 | ;;;; Paths | |
| 61 | ||
| 62 | (defun f-join (&rest args) | |
| 63 | "Join ARGS to a single path." | |
| 64 | (let (path (relative (f-relative? (car args)))) | |
| 65 | (-map | |
| 66 | (lambda (arg) | |
| 67 | (setq path (f-expand arg path))) | |
| 68 | args) | |
| 69 | (if relative (f-relative path) path))) | |
| 70 | ||
| 71 | (defun f-split (path) | |
| 72 | "Split PATH and return list containing parts." | |
| 73 | (let ((parts (s-split (f-path-separator) path 'omit-nulls))) | |
| 74 | (if (f-absolute? path) | |
| 75 | (push (f-path-separator) parts) | |
| 76 | parts))) | |
| 77 | ||
| 78 | (defun f-expand (path &optional dir) | |
| 79 | "Expand PATH relative to DIR (or `default-directory'). | |
| 80 | PATH and DIR can be either a directory names or directory file | |
| 81 | names. Return a directory name if PATH is a directory name, and | |
| 82 | a directory file name otherwise. File name handlers are | |
| 83 | ignored." | |
| 84 | (let (file-name-handler-alist) | |
| 85 | (expand-file-name path dir))) | |
| 86 | ||
| 87 | (defun f-filename (path) | |
| 88 | "Return the name of PATH." | |
| 89 | (file-name-nondirectory (directory-file-name path))) | |
| 90 | ||
| 91 | (defalias 'f-parent 'f-dirname) | |
| 92 | (defun f-dirname (path) | |
| 93 | "Return the parent directory to PATH." | |
| 94 | (let ((parent (file-name-directory | |
| 95 | (directory-file-name (f-expand path default-directory))))) | |
| 96 | (unless (f-same? path parent) | |
| 97 | (if (f-relative? path) | |
| 98 | (f-relative parent) | |
| 99 | (directory-file-name parent))))) | |
| 100 | ||
| 101 | (defun f-common-parent (paths) | |
| 102 | "Return the deepest common parent directory of PATHS." | |
| 103 | (cond | |
| 104 | ((not paths) nil) | |
| 105 | ((not (cdr paths)) (f-parent (car paths))) | |
| 106 | (:otherwise | |
| 107 | (let* ((paths (-map 'f-split paths)) | |
| 108 | (common (caar paths)) | |
| 109 | (re nil)) | |
| 110 | (while (and (not (null (car paths))) (--all? (equal (car it) common) paths)) | |
| 111 | (setq paths (-map 'cdr paths)) | |
| 112 | (push common re) | |
| 113 | (setq common (caar paths))) | |
| 114 | (cond | |
| 115 | ((null re) "") | |
| 116 | ((and (= (length re) 1) (f-root? (car re))) | |
| 117 | (f-root)) | |
| 118 | (:otherwise | |
| 119 | (concat (apply 'f-join (nreverse re)) "/"))))))) | |
| 120 | ||
| 121 | (defun f-ext (path) | |
| 122 | "Return the file extension of PATH. | |
| 123 | ||
| 124 | The extension, in a file name, is the part that follows the last | |
| 125 | '.', excluding version numbers and backup suffixes." | |
| 126 | (file-name-extension path)) | |
| 127 | ||
| 128 | (defun f-no-ext (path) | |
| 129 | "Return everything but the file extension of PATH." | |
| 130 | (file-name-sans-extension path)) | |
| 131 | ||
| 132 | (defun f-swap-ext (path ext) | |
| 133 | "Return PATH but with EXT as the new extension. | |
| 134 | EXT must not be nil or empty." | |
| 135 | (if (s-blank? ext) | |
| 136 | (error "Extension cannot be empty or nil") | |
| 137 | (concat (f-no-ext path) "." ext))) | |
| 138 | ||
| 139 | (defun f-base (path) | |
| 140 | "Return the name of PATH, excluding the extension of file." | |
| 141 | (f-no-ext (f-filename path))) | |
| 142 | ||
| 143 | (defun f-relative (path &optional dir) | |
| 144 | "Return PATH relative to DIR." | |
| 145 | (file-relative-name path dir)) | |
| 146 | ||
| 147 | (defalias 'f-abbrev 'f-short) | |
| 148 | (defun f-short (path) | |
| 149 | "Return abbrev of PATH. See `abbreviate-file-name'." | |
| 150 | (abbreviate-file-name path)) | |
| 151 | ||
| 152 | (defun f-long (path) | |
| 153 | "Return long version of PATH." | |
| 154 | (f-expand path)) | |
| 155 | ||
| 156 | (defun f-canonical (path) | |
| 157 | "Return the canonical name of PATH." | |
| 158 | (file-truename path)) | |
| 159 | ||
| 160 | (defun f-slash (path) | |
| 161 | "Append slash to PATH unless one already. | |
| 162 | ||
| 163 | Some functions, such as `call-process' requires there to be an | |
| 164 | ending slash." | |
| 165 | (if (f-dir? path) | |
| 166 | (file-name-as-directory path) | |
| 167 | path)) | |
| 168 | ||
| 169 | (defun f-full (path) | |
| 170 | "Return absolute path to PATH, with ending slash." | |
| 171 | (f-slash (f-long path))) | |
| 172 | ||
| 173 | (defun f--uniquify (paths) | |
| 174 | "Helper for `f-uniquify' and `f-uniquify-alist'." | |
| 175 | (let* ((files-length (length paths)) | |
| 176 | (uniq-filenames (--map (cons it (f-filename it)) paths)) | |
| 177 | (uniq-filenames-next (-group-by 'cdr uniq-filenames))) | |
| 178 | (while (/= files-length (length uniq-filenames-next)) | |
| 179 | (setq uniq-filenames-next | |
| 180 | (-group-by 'cdr | |
| 181 | (--mapcat | |
| 182 | (let ((conf-files (cdr it))) | |
| 183 | (if (> (length conf-files) 1) | |
| 184 | (--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files) | |
| 185 | conf-files)) | |
| 186 | uniq-filenames-next)))) | |
| 187 | uniq-filenames-next)) | |
| 188 | ||
| 189 | (defun f-uniquify (files) | |
| 190 | "Return unique suffixes of FILES. | |
| 191 | ||
| 192 | This function expects no duplicate paths." | |
| 193 | (-map 'car (f--uniquify files))) | |
| 194 | ||
| 195 | (defun f-uniquify-alist (files) | |
| 196 | "Return alist mapping FILES to unique suffixes of FILES. | |
| 197 | ||
| 198 | This function expects no duplicate paths." | |
| 199 | (-map 'cadr (f--uniquify files))) | |
| 200 | ||
| 201 | ||
| 202 | ;;;; I/O | |
| 203 | ||
| 204 | (defun f-read-bytes (path) | |
| 205 | "Read binary data from PATH. | |
| 206 | ||
| 207 | Return the binary data as unibyte string." | |
| 208 | (with-temp-buffer | |
| 209 | (set-buffer-multibyte nil) | |
| 210 | (setq buffer-file-coding-system 'binary) | |
| 211 | (insert-file-contents-literally path) | |
| 212 | (buffer-substring-no-properties (point-min) (point-max)))) | |
| 213 | ||
| 214 | (defalias 'f-read 'f-read-text) | |
| 215 | (defun f-read-text (path &optional coding) | |
| 216 | "Read text with PATH, using CODING. | |
| 217 | ||
| 218 | CODING defaults to `utf-8'. | |
| 219 | ||
| 220 | Return the decoded text as multibyte string." | |
| 221 | (decode-coding-string (f-read-bytes path) (or coding 'utf-8))) | |
| 222 | ||
| 223 | (defalias 'f-write 'f-write-text) | |
| 224 | (defun f-write-text (text coding path) | |
| 225 | "Write TEXT with CODING to PATH. | |
| 226 | ||
| 227 | TEXT is a multibyte string. CODING is a coding system to encode | |
| 228 | TEXT with. PATH is a file name to write to." | |
| 229 | (f-write-bytes (encode-coding-string text coding) path)) | |
| 230 | ||
| 231 | (defun f-unibyte-string-p (s) | |
| 232 | "Determine whether S is a unibyte string." | |
| 233 | (not (multibyte-string-p s))) | |
| 234 | ||
| 235 | (defun f-write-bytes (data path) | |
| 236 | "Write binary DATA to PATH. | |
| 237 | ||
| 238 | DATA is a unibyte string. PATH is a file name to write to." | |
| 239 | (f--destructive path | |
| 240 | (unless (f-unibyte-string-p data) | |
| 241 | (signal 'wrong-type-argument (list 'f-unibyte-string-p data))) | |
| 242 | (let ((file-coding-system-alist nil) | |
| 243 | (coding-system-for-write 'binary)) | |
| 244 | (with-temp-file path | |
| 245 | (setq buffer-file-coding-system 'binary) | |
| 246 | (set-buffer-multibyte nil) | |
| 247 | (insert data))))) | |
| 248 | ||
| 249 | (defalias 'f-append 'f-append-text) | |
| 250 | (defun f-append-text (text coding path) | |
| 251 | "Append TEXT with CODING to PATH. | |
| 252 | ||
| 253 | If PATH does not exist, it is created." | |
| 254 | (f-append-bytes (encode-coding-string text coding) path)) | |
| 255 | ||
| 256 | (defun f-append-bytes (data path) | |
| 257 | "Append binary DATA to PATH. | |
| 258 | ||
| 259 | If PATH does not exist, it is created." | |
| 260 | (let ((content | |
| 261 | (if (f-file? path) | |
| 262 | (f-read-bytes path) | |
| 263 | ""))) | |
| 264 | (f-write-bytes (concat content data) path))) | |
| 265 | ||
| 266 | ||
| 267 | ;;;; Destructive | |
| 268 | ||
| 269 | (defun f-mkdir (&rest dirs) | |
| 270 | "Create directories DIRS." | |
| 271 | (let (path) | |
| 272 | (-each | |
| 273 | dirs | |
| 274 | (lambda (dir) | |
| 275 | (setq path (f-expand dir path)) | |
| 276 | (unless (f-directory? path) | |
| 277 | (f--destructive path (make-directory path))))))) | |
| 278 | ||
| 279 | (defun f-delete (path &optional force) | |
| 280 | "Delete PATH, which can be file or directory. | |
| 281 | ||
| 282 | If FORCE is t, a directory will be deleted recursively." | |
| 283 | (f--destructive path | |
| 284 | (if (or (f-file? path) (f-symlink? path)) | |
| 285 | (delete-file path) | |
| 286 | (delete-directory path force)))) | |
| 287 | ||
| 288 | (defun f-symlink (source path) | |
| 289 | "Create a symlink to SOURCE from PATH." | |
| 290 | (f--destructive path (make-symbolic-link source path))) | |
| 291 | ||
| 292 | (defun f-move (from to) | |
| 293 | "Move or rename FROM to TO. | |
| 294 | If TO is a directory name, move FROM into TO." | |
| 295 | (f--destructive to (rename-file from to t))) | |
| 296 | ||
| 297 | (defun f-copy (from to) | |
| 298 | "Copy file or directory FROM to TO. | |
| 299 | If FROM names a directory and TO is a directory name, copy FROM | |
| 300 | into TO as a subdirectory." | |
| 301 | (f--destructive to | |
| 302 | (if (f-file? from) | |
| 303 | (copy-file from to) | |
| 304 | ;; The behavior of `copy-directory' differs between Emacs 23 and | |
| 305 | ;; 24 in that in Emacs 23, the contents of `from' is copied to | |
| 306 | ;; `to', while in Emacs 24 the directory `from' is copied to | |
| 307 | ;; `to'. We want the Emacs 24 behavior. | |
| 308 | (if (> emacs-major-version 23) | |
| 309 | (copy-directory from to) | |
| 310 | (if (f-dir? to) | |
| 311 | (progn | |
| 312 | (apply 'f-mkdir (f-split to)) | |
| 313 | (let ((new-to (f-expand (f-filename from) to))) | |
| 314 | (copy-directory from new-to))) | |
| 315 | (copy-directory from to)))))) | |
| 316 | ||
| 317 | (defun f-copy-contents (from to) | |
| 318 | "Copy contents in directory FROM, to directory TO." | |
| 319 | (unless (f-exists? to) | |
| 320 | (error "Cannot copy contents to non existing directory %s" to)) | |
| 321 | (unless (f-dir? from) | |
| 322 | (error "Cannot copy contents as %s is a file" from)) | |
| 323 | (--each (f-entries from) | |
| 324 | (f-copy it (file-name-as-directory to)))) | |
| 325 | ||
| 326 | (defun f-touch (path) | |
| 327 | "Update PATH last modification date or create if it does not exist." | |
| 328 | (f--destructive path | |
| 329 | (if (f-file? path) | |
| 330 | (set-file-times path) | |
| 331 | (f-write-bytes "" path)))) | |
| 332 | ||
| 333 | ||
| 334 | ;;;; Predicates | |
| 335 | ||
| 336 | (defun f-exists? (path) | |
| 337 | "Return t if PATH exists, false otherwise." | |
| 338 | (file-exists-p path)) | |
| 339 | ||
| 340 | (defalias 'f-exists-p 'f-exists?) | |
| 341 | ||
| 342 | (defalias 'f-dir? 'f-directory?) | |
| 343 | (defalias 'f-dir-p 'f-dir?) | |
| 344 | ||
| 345 | (defun f-directory? (path) | |
| 346 | "Return t if PATH is directory, false otherwise." | |
| 347 | (file-directory-p path)) | |
| 348 | ||
| 349 | (defalias 'f-directory-p 'f-directory?) | |
| 350 | ||
| 351 | (defun f-file? (path) | |
| 352 | "Return t if PATH is file, false otherwise." | |
| 353 | (file-regular-p path)) | |
| 354 | ||
| 355 | (defalias 'f-file-p 'f-file?) | |
| 356 | ||
| 357 | (defun f-symlink? (path) | |
| 358 | "Return t if PATH is symlink, false otherwise." | |
| 359 | (not (not (file-symlink-p path)))) | |
| 360 | ||
| 361 | (defalias 'f-symlink-p 'f-symlink?) | |
| 362 | ||
| 363 | (defun f-readable? (path) | |
| 364 | "Return t if PATH is readable, false otherwise." | |
| 365 | (file-readable-p path)) | |
| 366 | ||
| 367 | (defalias 'f-readable-p 'f-readable?) | |
| 368 | ||
| 369 | (defun f-writable? (path) | |
| 370 | "Return t if PATH is writable, false otherwise." | |
| 371 | (file-writable-p path)) | |
| 372 | ||
| 373 | (defalias 'f-writable-p 'f-writable?) | |
| 374 | ||
| 375 | (defun f-executable? (path) | |
| 376 | "Return t if PATH is executable, false otherwise." | |
| 377 | (file-executable-p path)) | |
| 378 | ||
| 379 | (defalias 'f-executable-p 'f-executable?) | |
| 380 | ||
| 381 | (defun f-absolute? (path) | |
| 382 | "Return t if PATH is absolute, false otherwise." | |
| 383 | (file-name-absolute-p path)) | |
| 384 | ||
| 385 | (defalias 'f-absolute-p 'f-absolute?) | |
| 386 | ||
| 387 | (defun f-relative? (path) | |
| 388 | "Return t if PATH is relative, false otherwise." | |
| 389 | (not (f-absolute? path))) | |
| 390 | ||
| 391 | (defalias 'f-relative-p 'f-relative?) | |
| 392 | ||
| 393 | (defun f-root? (path) | |
| 394 | "Return t if PATH is root directory, false otherwise." | |
| 395 | (not (f-parent path))) | |
| 396 | ||
| 397 | (defalias 'f-root-p 'f-root?) | |
| 398 | ||
| 399 | (defun f-ext? (path &optional ext) | |
| 400 | "Return t if extension of PATH is EXT, false otherwise. | |
| 401 | ||
| 402 | If EXT is nil or omitted, return t if PATH has any extension, | |
| 403 | false otherwise. | |
| 404 | ||
| 405 | The extension, in a file name, is the part that follows the last | |
| 406 | '.', excluding version numbers and backup suffixes." | |
| 407 | (if ext | |
| 408 | (string= (f-ext path) ext) | |
| 409 | (not (eq (f-ext path) nil)))) | |
| 410 | ||
| 411 | (defalias 'f-ext-p 'f-ext?) | |
| 412 | ||
| 413 | (defalias 'f-equal? 'f-same?) | |
| 414 | (defalias 'f-equal-p 'f-equal?) | |
| 415 | ||
| 416 | (defun f-same? (path-a path-b) | |
| 417 | "Return t if PATH-A and PATH-B are references to same file." | |
| 418 | (when (and (f-exists? path-a) | |
| 419 | (f-exists? path-b)) | |
| 420 | (equal | |
| 421 | (f-canonical (directory-file-name (f-expand path-a))) | |
| 422 | (f-canonical (directory-file-name (f-expand path-b)))))) | |
| 423 | ||
| 424 | (defalias 'f-same-p 'f-same?) | |
| 425 | ||
| 426 | (defun f-parent-of? (path-a path-b) | |
| 427 | "Return t if PATH-A is parent of PATH-B." | |
| 428 | (--when-let (f-parent path-b) | |
| 429 | (f-same? path-a it))) | |
| 430 | ||
| 431 | (defalias 'f-parent-of-p 'f-parent-of?) | |
| 432 | ||
| 433 | (defun f-child-of? (path-a path-b) | |
| 434 | "Return t if PATH-A is child of PATH-B." | |
| 435 | (--when-let (f-parent path-a) | |
| 436 | (f-same? it path-b))) | |
| 437 | ||
| 438 | (defalias 'f-child-of-p 'f-child-of?) | |
| 439 | ||
| 440 | (defun f-ancestor-of? (path-a path-b) | |
| 441 | "Return t if PATH-A is ancestor of PATH-B." | |
| 442 | (unless (f-same? path-a path-b) | |
| 443 | (s-starts-with? (f-full path-a) | |
| 444 | (f-full path-b)))) | |
| 445 | ||
| 446 | (defalias 'f-ancestor-of-p 'f-ancestor-of?) | |
| 447 | ||
| 448 | (defun f-descendant-of? (path-a path-b) | |
| 449 | "Return t if PATH-A is desendant of PATH-B." | |
| 450 | (unless (f-same? path-a path-b) | |
| 451 | (s-starts-with? (f-full path-b) | |
| 452 | (f-full path-a)))) | |
| 453 | ||
| 454 | (defalias 'f-descendant-of-p 'f-descendant-of?) | |
| 455 | ||
| 456 | (defun f-hidden? (path) | |
| 457 | "Return t if PATH is hidden, nil otherwise." | |
| 458 | (unless (f-exists? path) | |
| 459 | (error "Path does not exist: %s" path)) | |
| 460 | (string= (substring path 0 1) ".")) | |
| 461 | ||
| 462 | (defalias 'f-hidden-p 'f-hidden?) | |
| 463 | ||
| 464 | (defun f-empty? (path) | |
| 465 | "If PATH is a file, return t if the file in PATH is empty, nil otherwise. | |
| 466 | If PATH is directory, return t if directory has no files, nil otherwise." | |
| 467 | (if (f-directory? path) | |
| 468 | (equal (f-files path nil t) nil) | |
| 469 | (= (f-size path) 0))) | |
| 470 | ||
| 471 | (defalias 'f-empty-p 'f-empty?) | |
| 472 | ||
| 473 | ||
| 474 | ;;;; Stats | |
| 475 | ||
| 476 | (defun f-size (path) | |
| 477 | "Return size of PATH. | |
| 478 | ||
| 479 | If PATH is a file, return size of that file. If PATH is | |
| 480 | directory, return sum of all files in PATH." | |
| 481 | (if (f-directory? path) | |
| 482 | (-sum (-map 'f-size (f-files path nil t))) | |
| 483 | (nth 7 (file-attributes path)))) | |
| 484 | ||
| 485 | (defun f-depth (path) | |
| 486 | "Return the depth of PATH. | |
| 487 | ||
| 488 | At first, PATH is expanded with `f-expand'. Then the full path is used to | |
| 489 | detect the depth. | |
| 490 | '/' will be zero depth, '/usr' will be one depth. And so on." | |
| 491 | (- (length (f-split (f-expand path))) 1)) | |
| 492 | ||
| 493 | ||
| 494 | ;;;; Misc | |
| 495 | ||
| 496 | (defun f-this-file () | |
| 497 | "Return path to this file." | |
| 498 | (cond | |
| 499 | (load-in-progress load-file-name) | |
| 500 | ((and (boundp 'byte-compile-current-file) byte-compile-current-file) | |
| 501 | byte-compile-current-file) | |
| 502 | (:else (buffer-file-name)))) | |
| 503 | ||
| 504 | (defvar f--path-separator nil | |
| 505 | "A variable to cache result of `f-path-separator'.") | |
| 506 | ||
| 507 | (defun f-path-separator () | |
| 508 | "Return path separator." | |
| 509 | (or f--path-separator | |
| 510 | (setq f--path-separator (substring (f-join "x" "y") 1 2)))) | |
| 511 | ||
| 512 | (defun f-glob (pattern &optional path) | |
| 513 | "Find PATTERN in PATH." | |
| 514 | (file-expand-wildcards | |
| 515 | (f-join (or path default-directory) pattern))) | |
| 516 | ||
| 517 | (defun f--collect-entries (path recursive) | |
| 518 | (let (result | |
| 519 | (entries | |
| 520 | (-reject | |
| 521 | (lambda (file) | |
| 522 | (or | |
| 523 | (equal (f-filename file) ".") | |
| 524 | (equal (f-filename file) ".."))) | |
| 525 | (directory-files path t)))) | |
| 526 | (cond (recursive | |
| 527 | (-map | |
| 528 | (lambda (entry) | |
| 529 | (if (f-file? entry) | |
| 530 | (setq result (cons entry result)) | |
| 531 | (when (f-directory? entry) | |
| 532 | (setq result (cons entry result)) | |
| 533 | (setq result (append result (f--collect-entries entry recursive)))))) | |
| 534 | entries)) | |
| 535 | (t (setq result entries))) | |
| 536 | result)) | |
| 537 | ||
| 538 | (defmacro f--entries (path body &optional recursive) | |
| 539 | "Anaphoric version of `f-entries'." | |
| 540 | `(f-entries | |
| 541 | ,path | |
| 542 | (lambda (path) | |
| 543 | (let ((it path)) | |
| 544 | ,body)) | |
| 545 | ,recursive)) | |
| 546 | ||
| 547 | (defun f-entries (path &optional fn recursive) | |
| 548 | "Find all files and directories in PATH. | |
| 549 | ||
| 550 | FN - called for each found file and directory. If FN returns a thruthy | |
| 551 | value, file or directory will be included. | |
| 552 | RECURSIVE - Search for files and directories recursive." | |
| 553 | (let ((entries (f--collect-entries path recursive))) | |
| 554 | (if fn (-select fn entries) entries))) | |
| 555 | ||
| 556 | (defmacro f--directories (path body &optional recursive) | |
| 557 | "Anaphoric version of `f-directories'." | |
| 558 | `(f-directories | |
| 559 | ,path | |
| 560 | (lambda (path) | |
| 561 | (let ((it path)) | |
| 562 | ,body)) | |
| 563 | ,recursive)) | |
| 564 | ||
| 565 | (defun f-directories (path &optional fn recursive) | |
| 566 | "Find all directories in PATH. See `f-entries'." | |
| 567 | (let ((directories (-select 'f-directory? (f--collect-entries path recursive)))) | |
| 568 | (if fn (-select fn directories) directories))) | |
| 569 | ||
| 570 | (defmacro f--files (path body &optional recursive) | |
| 571 | "Anaphoric version of `f-files'." | |
| 572 | `(f-files | |
| 573 | ,path | |
| 574 | (lambda (path) | |
| 575 | (let ((it path)) | |
| 576 | ,body)) | |
| 577 | ,recursive)) | |
| 578 | ||
| 579 | (defun f-files (path &optional fn recursive) | |
| 580 | "Find all files in PATH. See `f-entries'." | |
| 581 | (let ((files (-select 'f-file? (f--collect-entries path recursive)))) | |
| 582 | (if fn (-select fn files) files))) | |
| 583 | ||
| 584 | (defmacro f--traverse-upwards (body &optional path) | |
| 585 | "Anaphoric version of `f-traverse-upwards'." | |
| 586 | `(f-traverse-upwards | |
| 587 | (lambda (dir) | |
| 588 | (let ((it dir)) | |
| 589 | ,body)) | |
| 590 | ,path)) | |
| 591 | ||
| 592 | (defun f-traverse-upwards (fn &optional path) | |
| 593 | "Traverse up as long as FN return nil, starting at PATH. | |
| 594 | ||
| 595 | If FN returns a non-nil value, the path sent as argument to FN is | |
| 596 | returned. If no function callback return a non-nil value, nil is | |
| 597 | returned." | |
| 598 | (unless path | |
| 599 | (setq path default-directory)) | |
| 600 | (when (f-relative? path) | |
| 601 | (setq path (f-expand path))) | |
| 602 | (if (funcall fn path) | |
| 603 | path | |
| 604 | (unless (f-root? path) | |
| 605 | (f-traverse-upwards fn (f-parent path))))) | |
| 606 | ||
| 607 | (defun f-root () | |
| 608 | "Return absolute root." | |
| 609 | (f-traverse-upwards 'f-root?)) | |
| 610 | ||
| 611 | (defmacro f-with-sandbox (path-or-paths &rest body) | |
| 612 | "Only allow PATH-OR-PATHS and decendants to be modified in BODY." | |
| 613 | (declare (indent 1)) | |
| 614 | `(let ((paths (if (listp ,path-or-paths) | |
| 615 | ,path-or-paths | |
| 616 | (list ,path-or-paths)))) | |
| 617 | (unwind-protect | |
| 618 | (let ((f--guard-paths paths)) | |
| 619 | ,@body) | |
| 620 | (setq f--guard-paths nil)))) | |
| 621 | ||
| 622 | (provide 'f) | |
| 623 | ||
| 624 | ;;; f.el ends here | |
