config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

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