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