config

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

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