f.el (25679B)
1 ;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2013 Johan Andersson 4 5 ;; Author: Johan Andersson <johan.rejeep@gmail.com> 6 ;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com> 7 ;; Version: 0.20.0 8 ;; Package-Requires: ((emacs "24.1") (s "1.7.0") (dash "2.2.0")) 9 ;; Keywords: files, directories 10 ;; Homepage: http://github.com/rejeep/f.el 11 12 ;; This file is NOT part of GNU Emacs. 13 14 ;;; License: 15 16 ;; This program is free software; you can redistribute it and/or modify 17 ;; it under the terms of the GNU General Public License as published by 18 ;; the Free Software Foundation; either version 3, or (at your option) 19 ;; any later version. 20 21 ;; This program is distributed in the hope that it will be useful, 22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 ;; GNU General Public License for more details. 25 26 ;; You should have received a copy of the GNU General Public License 27 ;; along with GNU Emacs; see the file COPYING. If not, write to the 28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 29 ;; Boston, MA 02110-1301, USA. 30 31 ;;; Commentary: 32 ;; 33 ;; Much inspired by magnar's excellent s.el and dash.el, f.el is a 34 ;; modern API for working with files and directories in Emacs. 35 36 ;;; Code: 37 38 39 40 (require 's) 41 (require 'dash) 42 (when (version<= "28.1" emacs-version) 43 (when (< emacs-major-version 29) 44 (require 'f-shortdoc nil t))) 45 46 (put 'f-guard-error 'error-conditions '(error f-guard-error)) 47 (put 'f-guard-error 'error-message "Destructive operation outside sandbox") 48 49 (defvar f--guard-paths nil 50 "List of allowed paths to modify when guarded. 51 52 Do not modify this variable.") 53 54 (defmacro f--destructive (path &rest body) 55 "If PATH is allowed to be modified, yield BODY. 56 57 If PATH is not allowed to be modified, throw error." 58 (declare (indent 1)) 59 `(if f--guard-paths 60 (if (--any? (or (f-same-p it ,path) 61 (f-ancestor-of-p it ,path)) f--guard-paths) 62 (progn ,@body) 63 (signal 'f-guard-error (list ,path f--guard-paths))) 64 ,@body)) 65 66 67 ;;;; Paths 68 69 (defun f-join (&rest args) 70 "Join ARGS to a single path. 71 72 Be aware if one of the arguments is an absolute path, `f-join' 73 will discard all the preceeding arguments and make this absolute 74 path the new root of the generated path." 75 (let (path 76 (relative (f-relative-p (car args)))) 77 (mapc 78 (lambda (arg) 79 (setq path (cond ((not path) arg) 80 ((f-absolute-p arg) 81 (progn 82 (setq relative nil) 83 arg)) 84 (t (f-expand arg path))))) 85 args) 86 (if relative (f-relative path) path))) 87 88 (defun f-split (path) 89 "Split PATH and return list containing parts." 90 (let ((parts (split-string path (f-path-separator) 'omit-nulls))) 91 (if (string= (s-left 1 path) (f-path-separator)) 92 (push (f-path-separator) parts) 93 parts))) 94 95 (defun f-expand (path &optional dir) 96 "Expand PATH relative to DIR (or `default-directory'). 97 PATH and DIR can be either a directory names or directory file 98 names. Return a directory name if PATH is a directory name, and 99 a directory file name otherwise. File name handlers are 100 ignored." 101 (let (file-name-handler-alist) 102 (expand-file-name path dir))) 103 104 (defun f-filename (path) 105 "Return the name of PATH." 106 (file-name-nondirectory (directory-file-name path))) 107 108 (defalias 'f-parent 'f-dirname) 109 110 (defun f-dirname (path) 111 "Return the parent directory to PATH." 112 (let ((parent (file-name-directory 113 (directory-file-name (f-expand path default-directory))))) 114 (unless (f-same-p path parent) 115 (if (f-relative-p path) 116 (f-relative parent) 117 (directory-file-name parent))))) 118 119 (defun f-common-parent (paths) 120 "Return the deepest common parent directory of PATHS." 121 (cond 122 ((not paths) nil) 123 ((not (cdr paths)) (f-parent (car paths))) 124 (:otherwise 125 (let* ((paths (-map 'f-split paths)) 126 (common (caar paths)) 127 (re nil)) 128 (while (and (not (null (car paths))) (--all? (equal (car it) common) paths)) 129 (setq paths (-map 'cdr paths)) 130 (push common re) 131 (setq common (caar paths))) 132 (cond 133 ((null re) "") 134 ((and (= (length re) 1) (f-root-p (car re))) 135 (f-root)) 136 (:otherwise 137 (concat (apply 'f-join (nreverse re)) "/"))))))) 138 139 (defalias 'f-ext 'file-name-extension) 140 141 (defalias 'f-no-ext 'file-name-sans-extension) 142 143 (defun f-swap-ext (path ext) 144 "Return PATH but with EXT as the new extension. 145 EXT must not be nil or empty." 146 (if (s-blank-p ext) 147 (error "Extension cannot be empty or nil") 148 (concat (f-no-ext path) "." ext))) 149 150 (defun f-base (path) 151 "Return the name of PATH, excluding the extension of file." 152 (f-no-ext (f-filename path))) 153 154 (defalias 'f-relative 'file-relative-name) 155 156 (defalias 'f-short 'abbreviate-file-name) 157 (defalias 'f-abbrev 'abbreviate-file-name) 158 159 (defun f-long (path) 160 "Return long version of PATH." 161 (f-expand path)) 162 163 (defalias 'f-canonical 'file-truename) 164 165 (defun f-slash (path) 166 "Append slash to PATH unless one already. 167 168 Some functions, such as `call-process' requires there to be an 169 ending slash." 170 (if (f-dir-p path) 171 (file-name-as-directory path) 172 path)) 173 174 (defun f-full (path) 175 "Return absolute path to PATH, with ending slash." 176 (f-slash (f-long path))) 177 178 (defun f--uniquify (paths) 179 "Helper for `f-uniquify' and `f-uniquify-alist'." 180 (let* ((files-length (length paths)) 181 (uniq-filenames (--map (cons it (f-filename it)) paths)) 182 (uniq-filenames-next (-group-by 'cdr uniq-filenames))) 183 (while (/= files-length (length uniq-filenames-next)) 184 (setq uniq-filenames-next 185 (-group-by 'cdr 186 (--mapcat 187 (let ((conf-files (cdr it))) 188 (if (> (length conf-files) 1) 189 (--map (cons 190 (car it) 191 (concat 192 (f-filename (s-chop-suffix (cdr it) 193 (car it))) 194 (f-path-separator) (cdr it))) 195 conf-files) 196 conf-files)) 197 uniq-filenames-next)))) 198 uniq-filenames-next)) 199 200 (defun f-uniquify (files) 201 "Return unique suffixes of FILES. 202 203 This function expects no duplicate paths." 204 (-map 'car (f--uniquify files))) 205 206 (defun f-uniquify-alist (files) 207 "Return alist mapping FILES to unique suffixes of FILES. 208 209 This function expects no duplicate paths." 210 (-map 'cadr (f--uniquify files))) 211 212 213 ;;;; I/O 214 215 (defun f-read-bytes (path &optional beg end) 216 "Read binary data from PATH. 217 218 Return the binary data as unibyte string. The optional second 219 and third arguments BEG and END specify what portion of the file 220 to read." 221 (with-temp-buffer 222 (set-buffer-multibyte nil) 223 (setq buffer-file-coding-system 'binary) 224 (insert-file-contents-literally path nil beg end) 225 (buffer-substring-no-properties (point-min) (point-max)))) 226 227 (defalias 'f-read 'f-read-text) 228 (defun f-read-text (path &optional coding) 229 "Read text with PATH, using CODING. 230 231 CODING defaults to `utf-8'. 232 233 Return the decoded text as multibyte string." 234 (decode-coding-string (f-read-bytes path) (or coding 'utf-8))) 235 236 (defalias 'f-write 'f-write-text) 237 (defun f-write-text (text coding path) 238 "Write TEXT with CODING to PATH. 239 240 TEXT is a multibyte string. CODING is a coding system to encode 241 TEXT with. PATH is a file name to write to." 242 (f-write-bytes (encode-coding-string text coding) path)) 243 244 (defun f-unibyte-string-p (s) 245 "Determine whether S is a unibyte string." 246 (not (multibyte-string-p s))) 247 248 (defun f-write-bytes (data path) 249 "Write binary DATA to PATH. 250 251 DATA is a unibyte string. PATH is a file name to write to." 252 (f--write-bytes data path nil)) 253 254 (defalias 'f-append 'f-append-text) 255 (defun f-append-text (text coding path) 256 "Append TEXT with CODING to PATH. 257 258 If PATH does not exist, it is created." 259 (f-append-bytes (encode-coding-string text coding) path)) 260 261 (defun f-append-bytes (data path) 262 "Append binary DATA to PATH. 263 264 If PATH does not exist, it is created." 265 (f--write-bytes data path :append)) 266 267 (defun f--write-bytes (data filename append) 268 "Write binary DATA to FILENAME. 269 If APPEND is non-nil, append the DATA to the existing contents." 270 (f--destructive filename 271 (unless (f-unibyte-string-p data) 272 (signal 'wrong-type-argument (list 'f-unibyte-string-p data))) 273 (let ((coding-system-for-write 'binary) 274 (write-region-annotate-functions nil) 275 (write-region-post-annotation-function nil)) 276 (write-region data nil filename append :silent) 277 nil))) 278 279 280 ;;;; Destructive 281 282 (defun f-mkdir (&rest dirs) 283 "Create directories DIRS. 284 285 DIRS should be a successive list of directories forming together 286 a full path. The easiest way to call this function with a fully 287 formed path is using `f-split' alongside it: 288 289 (apply #\\='f-mkdir (f-split \"path/to/file\")) 290 291 Although it works sometimes, it is not recommended to use fully 292 formed paths in the function. In this case, it is recommended to 293 use `f-mkdir-full-path' instead." 294 (let (path) 295 (-each 296 dirs 297 (lambda (dir) 298 (setq path (f-expand dir path)) 299 (unless (f-directory-p path) 300 (f--destructive path (make-directory path))))))) 301 302 (defun f-mkdir-full-path (dir) 303 "Create DIR from a full path. 304 305 This function is similar to `f-mkdir' except it can accept a full 306 path instead of requiring several successive directory names." 307 (apply #'f-mkdir (f-split dir))) 308 309 (defun f-delete (path &optional force) 310 "Delete PATH, which can be file or directory. 311 312 If FORCE is t, a directory will be deleted recursively." 313 (f--destructive path 314 (if (or (f-file-p path) (f-symlink-p path)) 315 (delete-file path) 316 (delete-directory path force)))) 317 318 (defun f-symlink (source path) 319 "Create a symlink to SOURCE from PATH." 320 (f--destructive path (make-symbolic-link source path))) 321 322 (defun f-move (from to) 323 "Move or rename FROM to TO. 324 If TO is a directory name, move FROM into TO." 325 (f--destructive to (rename-file from to t))) 326 327 (defun f-copy (from to) 328 "Copy file or directory FROM to TO. 329 If FROM names a directory and TO is a directory name, copy FROM 330 into TO as a subdirectory." 331 (f--destructive to 332 (if (f-file-p from) 333 (copy-file from to) 334 ;; The behavior of `copy-directory' differs between Emacs 23 and 335 ;; 24 in that in Emacs 23, the contents of `from' is copied to 336 ;; `to', while in Emacs 24 the directory `from' is copied to 337 ;; `to'. We want the Emacs 24 behavior. 338 (if (> emacs-major-version 23) 339 (copy-directory from to) 340 (if (f-dir-p to) 341 (progn 342 (apply 'f-mkdir (f-split to)) 343 (let ((new-to (f-expand (f-filename from) to))) 344 (copy-directory from new-to))) 345 (copy-directory from to)))))) 346 347 (defun f-copy-contents (from to) 348 "Copy contents in directory FROM, to directory TO." 349 (unless (f-exists-p to) 350 (error "Cannot copy contents to non existing directory %s" to)) 351 (unless (f-dir-p from) 352 (error "Cannot copy contents as %s is a file" from)) 353 (--each (f-entries from) 354 (f-copy it (file-name-as-directory to)))) 355 356 (defun f-touch (path) 357 "Update PATH last modification date or create if it does not exist." 358 (f--destructive path 359 (if (f-file-p path) 360 (set-file-times path) 361 (f-write-bytes "" path)))) 362 363 364 ;;;; Predicates 365 366 (defalias 'f-exists-p 'file-exists-p) 367 (defalias 'f-exists? 'file-exists-p) 368 369 (defalias 'f-directory-p 'file-directory-p) 370 (defalias 'f-directory? 'file-directory-p) 371 (defalias 'f-dir-p 'file-directory-p) 372 (defalias 'f-dir? 'file-directory-p) 373 374 375 (defalias 'f-file-p 'file-regular-p) 376 (defalias 'f-file? 'file-regular-p) 377 378 (defun f-symlink-p (path) 379 "Return t if PATH is symlink, false otherwise." 380 (not (not (file-symlink-p path)))) 381 382 (defalias 'f-symlink? 'f-symlink-p) 383 384 (defalias 'f-readable-p 'file-readable-p) 385 (defalias 'f-readable? 'file-readable-p) 386 387 (defalias 'f-writable-p 'file-writable-p) 388 (defalias 'f-writable? 'file-writable-p) 389 390 (defalias 'f-executable-p 'file-executable-p) 391 (defalias 'f-executable? 'file-executable-p) 392 393 (defalias 'f-absolute-p 'file-name-absolute-p) 394 (defalias 'f-absolute? 'file-name-absolute-p) 395 396 (defun f-relative-p (path) 397 "Return t if PATH is relative, false otherwise." 398 (not (f-absolute-p path))) 399 400 (defalias 'f-relative? 'f-relative-p) 401 402 (defun f-root-p (path) 403 "Return t if PATH is root directory, false otherwise." 404 (not (f-parent path))) 405 406 (defalias 'f-root? 'f-root-p) 407 408 (defun f-ext-p (path &optional ext) 409 "Return t if extension of PATH is EXT, false otherwise. 410 411 If EXT is nil or omitted, return t if PATH has any extension, 412 false otherwise. 413 414 The extension, in a file name, is the part that follows the last 415 '.', excluding version numbers and backup suffixes." 416 (if ext 417 (string= (f-ext path) ext) 418 (not (eq (f-ext path) nil)))) 419 420 (defalias 'f-ext? 'f-ext-p) 421 422 (defalias 'f-equal-p 'f-same-p) 423 (defalias 'f-equal? 'f-same-p) 424 425 (defun f-same-p (path-a path-b) 426 "Return t if PATH-A and PATH-B are references to same file." 427 (equal 428 (f-canonical (directory-file-name (f-expand path-a))) 429 (f-canonical (directory-file-name (f-expand path-b))))) 430 431 (defalias 'f-same? 'f-same-p) 432 433 (defun f-parent-of-p (path-a path-b) 434 "Return t if PATH-A is parent of PATH-B." 435 (--when-let (f-parent path-b) 436 (f-same-p path-a it))) 437 438 (defalias 'f-parent-of? 'f-parent-of-p) 439 440 (defun f-child-of-p (path-a path-b) 441 "Return t if PATH-A is child of PATH-B." 442 (--when-let (f-parent path-a) 443 (f-same-p it path-b))) 444 445 (defalias 'f-child-of? 'f-child-of-p) 446 447 (defun f-ancestor-of-p (path-a path-b) 448 "Return t if PATH-A is ancestor of PATH-B." 449 (unless (f-same-p path-a path-b) 450 (string-prefix-p (f-full path-a) 451 (f-full path-b)))) 452 453 (defalias 'f-ancestor-of? 'f-ancestor-of-p) 454 455 (defun f-descendant-of-p (path-a path-b) 456 "Return t if PATH-A is desendant of PATH-B." 457 (unless (f-same-p path-a path-b) 458 (let ((path-a (f-split (f-full path-a))) 459 (path-b (f-split (f-full path-b))) 460 (parent-p t)) 461 (while (and path-b parent-p) 462 (if (string= (car path-a) (car path-b)) 463 (setq path-a (cdr path-a) 464 path-b (cdr path-b)) 465 (setq parent-p nil))) 466 parent-p))) 467 468 (defalias 'f-descendant-of? 'f-descendant-of-p) 469 470 (defun f-hidden-p (path &optional behavior) 471 "Return t if PATH is hidden, nil otherwise. 472 473 BEHAVIOR controls when a path should be considered as hidden 474 depending on its value. Beware, if PATH begins with \"./\", the 475 current dir \".\" will not be considered as hidden. 476 477 When BEHAVIOR is nil, it will only check if the path begins with 478 a dot, as in .a/b/c, and return t if there is one. This is the 479 old behavior of f.el left as default for backward-compatibility 480 purposes. 481 482 When BEHAVIOR is ANY, return t if any of the elements of PATH is 483 hidden, nil otherwise. 484 485 When BEHAVIOR is LAST, return t only if the last element of PATH 486 is hidden, nil otherwise. 487 488 TODO: Hidden directories and files on Windows are marked 489 differently than on *NIX systems. This should be properly 490 implemented." 491 (let ((split-path (f-split path)) 492 (check-hidden (lambda (elt) 493 (and (string= (substring elt 0 1) ".") 494 (not (member elt '("." ".."))))))) 495 (pcase behavior 496 ('any (-any check-hidden split-path)) 497 ('last (apply check-hidden (last split-path))) 498 (otherwise (if (null otherwise) 499 (funcall check-hidden (car split-path)) 500 (error "Invalid value %S for argument BEHAVIOR" otherwise)))))) 501 502 (defalias 'f-hidden? 'f-hidden-p) 503 504 (defun f-empty-p (path) 505 "If PATH is a file, return t if the file in PATH is empty, nil otherwise. 506 If PATH is directory, return t if directory has no files, nil otherwise." 507 (if (f-directory-p path) 508 (equal (f-files path nil t) nil) 509 (= (f-size path) 0))) 510 511 (defalias 'f-empty? 'f-empty-p) 512 513 514 ;;;; Stats 515 516 (defun f-size (path) 517 "Return size of PATH. 518 519 If PATH is a file, return size of that file. If PATH is 520 directory, return sum of all files in PATH." 521 (if (f-directory-p path) 522 (-sum (-map 'f-size (f-files path nil t))) 523 (nth 7 (file-attributes path)))) 524 525 (defun f-depth (path) 526 "Return the depth of PATH. 527 528 At first, PATH is expanded with `f-expand'. Then the full path is used to 529 detect the depth. 530 '/' will be zero depth, '/usr' will be one depth. And so on." 531 (- (length (f-split (f-expand path))) 1)) 532 533 ;; For Emacs 28 and below, forward-declare ‘current-time-list’, which was 534 ;; introduced in Emacs 29. 535 (defvar current-time-list) 536 537 (defun f--get-time (path timestamp-p fn) 538 "Helper function, get time-related information for PATH. 539 Helper for `f-change-time', `f-modification-time', 540 `f-access-time'. It is meant to be called internally, avoid 541 calling it manually unless you have to. 542 543 If TIMESTAMP-P is non-nil, return the date requested as a 544 timestamp. If the value is \\='seconds, return the timestamp as 545 a timestamp with a one-second precision. Otherwise, the 546 timestamp is returned in a (TICKS . HZ) format, see 547 `current-time' if using Emacs 29 or newer. 548 549 Otherwise, if TIMESTAMP-P is nil, return the default style of 550 `current-time'. 551 552 FN is the function specified by the caller function to retrieve 553 the correct data from PATH." 554 (let* ((current-time-list (not timestamp-p)) 555 (date (apply fn (list (file-attributes path)))) 556 (emacs29-or-newer-p (version<= "29" emacs-version))) 557 (cond 558 ((and (eq timestamp-p 'seconds) emacs29-or-newer-p) 559 (/ (car date) (cdr date))) 560 ((or (and (not (eq timestamp-p 'seconds)) emacs29-or-newer-p) 561 (and (not timestamp-p) (not emacs29-or-newer-p))) 562 date) 563 ((and (eq timestamp-p 'seconds) (not emacs29-or-newer-p)) 564 (+ (* (nth 0 date) (expt 2 16)) 565 (nth 1 date))) 566 ((and timestamp-p (not emacs29-or-newer-p)) 567 `(,(+ (* (nth 0 date) (expt 2 16) 1000) 568 (* (nth 1 date) 1000) 569 (nth 3 date)) 570 . 1000))))) 571 572 (defun f-change-time (path &optional timestamp-p) 573 "Return the last status change time of PATH. 574 575 The status change time (ctime) of PATH in the same format as 576 `current-time'. For details on TIMESTAMP-P and the format of the 577 returned value, see `f--get-time'." 578 (f--get-time path 579 timestamp-p 580 (if (fboundp 'file-attribute-status-change-time) 581 #'file-attribute-status-change-time 582 (lambda (f) (nth 6 f))))) 583 584 (defun f-modification-time (path &optional timestamp-p) 585 "Return the last modification time of PATH. 586 The modification time (mtime) of PATH in the same format as 587 `current-time'. For details on TIMESTAMP-P and the format of the 588 returned value, see `f--get-time'." 589 (f--get-time path 590 timestamp-p 591 (if (fboundp 'file-attribute-modification-time) 592 #'file-attribute-modification-time 593 (lambda (f) (nth 5 f))))) 594 595 (defun f-access-time (path &optional timestamp-p) 596 "Return the last access time of PATH. 597 The access time (atime) of PATH is in the same format as 598 `current-time'. For details on TIMESTAMP-P and the format of the 599 returned value, see `f--get-time'." 600 (f--get-time path 601 timestamp-p 602 (if (fboundp 'file-attribute-access-time) 603 #'file-attribute-access-time 604 (lambda (f) (nth 4 f))))) 605 606 (defun f--three-way-compare (a b) 607 "Three way comparison. 608 609 Return -1 if A < B. 610 Return 0 if A = B. 611 Return 1 if A > B." 612 (cond ((< a b) -1) 613 ((= a b) 0) 614 ((> a b) 1))) 615 616 ;; TODO: How to properly test this function? 617 (defun f--date-compare (file other method) 618 "Three-way comparison of the date of FILE and OTHER. 619 620 This function can return three values: 621 * 1 means FILE is newer than OTHER 622 * 0 means FILE and NEWER share the same date 623 * -1 means FILE is older than OTHER 624 625 The statistics used for the date comparison depends on METHOD. 626 When METHOD is null, compare their modification time. Otherwise, 627 compare their change time when METHOD is \\='change, or compare 628 their last access time when METHOD is \\='access." 629 (let* ((fn-method (cond 630 ((eq 'change method) #'f-change-time) 631 ((eq 'access method) #'f-access-time) 632 ((null method) #'f-modification-time) 633 (t (error "Unknown method %S" method)))) 634 (date-file (apply fn-method (list file))) 635 (date-other (apply fn-method (list other))) 636 (dates (-zip-pair date-file date-other))) 637 (-reduce-from (lambda (acc elt) 638 (if (= acc 0) 639 (f--three-way-compare (car elt) (cdr elt)) 640 acc)) 641 0 642 dates))) 643 644 (defun f-older-p (file other &optional method) 645 "Compare if FILE is older than OTHER. 646 647 For more info on METHOD, see `f--date-compare'." 648 (< (f--date-compare file other method) 0)) 649 650 (defalias 'f-older? #'f-older-p) 651 652 (defun f-newer-p (file other &optional method) 653 "Compare if FILE is newer than OTHER. 654 655 For more info on METHOD, see `f--date-compare'." 656 (> (f--date-compare file other method) 0)) 657 658 (defalias 'f-newer? #'f-newer-p) 659 660 (defun f-same-time-p (file other &optional method) 661 "Check if FILE and OTHER share the same access or modification time. 662 663 For more info on METHOD, see `f--date-compare'." 664 (= (f--date-compare file other method) 0)) 665 666 (defalias 'f-same-time? #'f-same-time-p) 667 668 669 ;;;; Misc 670 671 (defun f-this-file () 672 "Return path to this file." 673 (cond 674 (load-in-progress load-file-name) 675 ((and (boundp 'byte-compile-current-file) byte-compile-current-file) 676 byte-compile-current-file) 677 (:else (buffer-file-name)))) 678 679 (defvar f--path-separator nil 680 "A variable to cache result of `f-path-separator'.") 681 682 (defun f-path-separator () 683 "Return path separator." 684 (or f--path-separator 685 (setq f--path-separator (substring (f-join "x" "y") 1 2)))) 686 687 (defun f-glob (pattern &optional path) 688 "Find PATTERN in PATH." 689 (file-expand-wildcards 690 (f-join (or path default-directory) pattern))) 691 692 (defun f--collect-entries (path recursive) 693 (let (result 694 (entries 695 (-reject 696 (lambda (file) 697 (member (f-filename file) '("." ".."))) 698 (directory-files path t)))) 699 (cond (recursive 700 (mapc 701 (lambda (entry) 702 (if (f-file-p entry) 703 (setq result (cons entry result)) 704 (when (f-directory-p entry) 705 (setq result (cons entry result)) 706 (if (f-readable-p entry) 707 (setq result (append result (f--collect-entries entry recursive))) 708 result)))) 709 entries)) 710 (t (setq result entries))) 711 result)) 712 713 (defmacro f--entries (path body &optional recursive) 714 "Anaphoric version of `f-entries'." 715 `(f-entries 716 ,path 717 (lambda (path) 718 (let ((it path)) 719 ,body)) 720 ,recursive)) 721 722 (defun f-entries (path &optional fn recursive) 723 "Find all files and directories in PATH. 724 725 FN - called for each found file and directory. If FN returns a thruthy 726 value, file or directory will be included. 727 RECURSIVE - Search for files and directories recursive." 728 (let ((entries (f--collect-entries path recursive))) 729 (if fn (-select fn entries) entries))) 730 731 (defmacro f--directories (path body &optional recursive) 732 "Anaphoric version of `f-directories'." 733 `(f-directories 734 ,path 735 (lambda (path) 736 (let ((it path)) 737 ,body)) 738 ,recursive)) 739 740 (defun f-directories (path &optional fn recursive) 741 "Find all directories in PATH. See `f-entries'." 742 (let ((directories (-select 'f-directory-p (f--collect-entries path recursive)))) 743 (if fn (-select fn directories) directories))) 744 745 (defmacro f--files (path body &optional recursive) 746 "Anaphoric version of `f-files'." 747 `(f-files 748 ,path 749 (lambda (path) 750 (let ((it path)) 751 ,body)) 752 ,recursive)) 753 754 (defun f-files (path &optional fn recursive) 755 "Find all files in PATH. See `f-entries'." 756 (let ((files (-select 'f-file-p (f--collect-entries path recursive)))) 757 (if fn (-select fn files) files))) 758 759 (defmacro f--traverse-upwards (body &optional path) 760 "Anaphoric version of `f-traverse-upwards'." 761 `(f-traverse-upwards 762 (lambda (dir) 763 (let ((it dir)) 764 ,body)) 765 ,path)) 766 767 (defun f-traverse-upwards (fn &optional path) 768 "Traverse up as long as FN return nil, starting at PATH. 769 770 If FN returns a non-nil value, the path sent as argument to FN is 771 returned. If no function callback return a non-nil value, nil is 772 returned." 773 (unless path 774 (setq path default-directory)) 775 (when (f-relative-p path) 776 (setq path (f-expand path))) 777 (if (funcall fn path) 778 path 779 (unless (f-root-p path) 780 (f-traverse-upwards fn (f-parent path))))) 781 782 (defun f-root () 783 "Return absolute root." 784 (f-traverse-upwards 'f-root-p)) 785 786 (defmacro f-with-sandbox (path-or-paths &rest body) 787 "Only allow PATH-OR-PATHS and descendants to be modified in BODY." 788 (declare (indent 1)) 789 `(let ((paths (if (listp ,path-or-paths) 790 ,path-or-paths 791 (list ,path-or-paths)))) 792 (unwind-protect 793 (let ((f--guard-paths paths)) 794 ,@body) 795 (setq f--guard-paths nil)))) 796 797 (provide 'f) 798 799 ;;; f.el ends here