dotemacs

f.el (18374B)

---

 ;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2013 Johan Andersson
 
 ;; Author: Johan Andersson <johan.rejeep@gmail.com>
 ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
 ;; Version: 0.20.0
 ;; Package-Version: 0.20.0
 ;; Package-Commit: de6d4d40ddc844eee643e92d47b9d6a63fbebb48
 ;; Keywords: files, directories
 ;; URL: http://github.com/rejeep/f.el
 ;; Package-Requires: ((s "1.7.0") (dash "2.2.0"))
 
 ;; This file is NOT part of GNU Emacs.
 
 ;;; License:
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
 
 
 (require 's)
 (require 'dash)
 
 (put 'f-guard-error 'error-conditions '(error f-guard-error))
 (put 'f-guard-error 'error-message "Destructive operation outside sandbox")
 
 (defvar f--guard-paths nil
   "List of allowed paths to modify when guarded.
 
 Do not modify this variable.")
 
 (defmacro f--destructive (path &rest body)
   "If PATH is allowed to be modified, yield BODY.
 
 If PATH is not allowed to be modified, throw error."
   (declare (indent 1))
   `(if f--guard-paths
        (if (--any? (or (f-same? it ,path)
                        (f-ancestor-of? it ,path)) f--guard-paths)
            (progn ,@body)
          (signal 'f-guard-error (list ,path f--guard-paths)))
      ,@body))
 
 
 ;;;; Paths
 
 (defun f-join (&rest args)
   "Join ARGS to a single path."
   (let (path (relative (f-relative? (car args))))
     (-map
      (lambda (arg)
        (setq path (f-expand arg path)))
      args)
     (if relative (f-relative path) path)))
 
 (defun f-split (path)
   "Split PATH and return list containing parts."
   (let ((parts (s-split (f-path-separator) path 'omit-nulls)))
     (if (f-absolute? path)
         (push (f-path-separator) parts)
       parts)))
 
 (defun f-expand (path &optional dir)
   "Expand PATH relative to DIR (or `default-directory').
 PATH and DIR can be either a directory names or directory file
 names.  Return a directory name if PATH is a directory name, and
 a directory file name otherwise.  File name handlers are
 ignored."
   (let (file-name-handler-alist)
     (expand-file-name path dir)))
 
 (defun f-filename (path)
   "Return the name of PATH."
   (file-name-nondirectory (directory-file-name path)))
 
 (defalias 'f-parent 'f-dirname)
 (defun f-dirname (path)
   "Return the parent directory to PATH."
   (let ((parent (file-name-directory
                  (directory-file-name (f-expand path default-directory)))))
     (unless (f-same? path parent)
       (if (f-relative? path)
           (f-relative parent)
         (directory-file-name parent)))))
 
 (defun f-common-parent (paths)
   "Return the deepest common parent directory of PATHS."
   (cond
    ((not paths) nil)
    ((not (cdr paths)) (f-parent (car paths)))
    (:otherwise
     (let* ((paths (-map 'f-split paths))
            (common (caar paths))
            (re nil))
       (while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
         (setq paths (-map 'cdr paths))
         (push common re)
         (setq common (caar paths)))
       (cond
        ((null re) "")
        ((and (= (length re) 1) (f-root? (car re)))
         (f-root))
        (:otherwise
         (concat (apply 'f-join (nreverse re)) "/")))))))
 
 (defun f-ext (path)
   "Return the file extension of PATH.
 
 The extension, in a file name, is the part that follows the last
 '.', excluding version numbers and backup suffixes."
   (file-name-extension path))
 
 (defun f-no-ext (path)
   "Return everything but the file extension of PATH."
   (file-name-sans-extension path))
 
 (defun f-swap-ext (path ext)
   "Return PATH but with EXT as the new extension.
 EXT must not be nil or empty."
   (if (s-blank? ext)
       (error "Extension cannot be empty or nil")
     (concat (f-no-ext path) "." ext)))
 
 (defun f-base (path)
   "Return the name of PATH, excluding the extension of file."
   (f-no-ext (f-filename path)))
 
 (defun f-relative (path &optional dir)
   "Return PATH relative to DIR."
   (file-relative-name path dir))
 
 (defalias 'f-abbrev 'f-short)
 (defun f-short (path)
   "Return abbrev of PATH.  See `abbreviate-file-name'."
   (abbreviate-file-name path))
 
 (defun f-long (path)
   "Return long version of PATH."
   (f-expand path))
 
 (defun f-canonical (path)
   "Return the canonical name of PATH."
   (file-truename path))
 
 (defun f-slash (path)
   "Append slash to PATH unless one already.
 
 Some functions, such as `call-process' requires there to be an
 ending slash."
   (if (f-dir? path)
       (file-name-as-directory path)
     path))
 
 (defun f-full (path)
   "Return absolute path to PATH, with ending slash."
   (f-slash (f-long path)))
 
 (defun f--uniquify (paths)
   "Helper for `f-uniquify' and `f-uniquify-alist'."
   (let* ((files-length (length paths))
          (uniq-filenames (--map (cons it (f-filename it)) paths))
          (uniq-filenames-next (-group-by 'cdr uniq-filenames)))
     (while (/= files-length (length uniq-filenames-next))
       (setq uniq-filenames-next
             (-group-by 'cdr
                        (--mapcat
                         (let ((conf-files (cdr it)))
                           (if (> (length conf-files) 1)
                               (--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files)
                             conf-files))
                         uniq-filenames-next))))
     uniq-filenames-next))
 
 (defun f-uniquify (files)
   "Return unique suffixes of FILES.
 
 This function expects no duplicate paths."
   (-map 'car (f--uniquify files)))
 
 (defun f-uniquify-alist (files)
   "Return alist mapping FILES to unique suffixes of FILES.
 
 This function expects no duplicate paths."
   (-map 'cadr (f--uniquify files)))
 
 
 ;;;; I/O
 
 (defun f-read-bytes (path)
   "Read binary data from PATH.
 
 Return the binary data as unibyte string."
   (with-temp-buffer
     (set-buffer-multibyte nil)
     (setq buffer-file-coding-system 'binary)
     (insert-file-contents-literally path)
     (buffer-substring-no-properties (point-min) (point-max))))
 
 (defalias 'f-read 'f-read-text)
 (defun f-read-text (path &optional coding)
   "Read text with PATH, using CODING.
 
 CODING defaults to `utf-8'.
 
 Return the decoded text as multibyte string."
   (decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
 
 (defalias 'f-write 'f-write-text)
 (defun f-write-text (text coding path)
   "Write TEXT with CODING to PATH.
 
 TEXT is a multibyte string.  CODING is a coding system to encode
 TEXT with.  PATH is a file name to write to."
   (f-write-bytes (encode-coding-string text coding) path))
 
 (defun f-unibyte-string-p (s)
   "Determine whether S is a unibyte string."
   (not (multibyte-string-p s)))
 
 (defun f-write-bytes (data path)
   "Write binary DATA to PATH.
 
 DATA is a unibyte string.  PATH is a file name to write to."
   (f--destructive path
     (unless (f-unibyte-string-p data)
       (signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
     (let ((file-coding-system-alist nil)
           (coding-system-for-write 'binary))
       (with-temp-file path
         (setq buffer-file-coding-system 'binary)
         (set-buffer-multibyte nil)
         (insert data)))))
 
 (defalias 'f-append 'f-append-text)
 (defun f-append-text (text coding path)
   "Append TEXT with CODING to PATH.
 
 If PATH does not exist, it is created."
   (f-append-bytes (encode-coding-string text coding) path))
 
 (defun f-append-bytes (data path)
   "Append binary DATA to PATH.
 
 If PATH does not exist, it is created."
   (let ((content
          (if (f-file? path)
              (f-read-bytes path)
            "")))
     (f-write-bytes (concat content data) path)))
 
 
 ;;;; Destructive
 
 (defun f-mkdir (&rest dirs)
   "Create directories DIRS."
   (let (path)
     (-each
         dirs
       (lambda (dir)
         (setq path (f-expand dir path))
         (unless (f-directory? path)
           (f--destructive path (make-directory path)))))))
 
 (defun f-delete (path &optional force)
   "Delete PATH, which can be file or directory.
 
 If FORCE is t, a directory will be deleted recursively."
   (f--destructive path
     (if (or (f-file? path) (f-symlink? path))
         (delete-file path)
       (delete-directory path force))))
 
 (defun f-symlink (source path)
   "Create a symlink to SOURCE from PATH."
   (f--destructive path (make-symbolic-link source path)))
 
 (defun f-move (from to)
   "Move or rename FROM to TO.
 If TO is a directory name, move FROM into TO."
   (f--destructive to (rename-file from to t)))
 
 (defun f-copy (from to)
   "Copy file or directory FROM to TO.
 If FROM names a directory and TO is a directory name, copy FROM
 into TO as a subdirectory."
   (f--destructive to
     (if (f-file? from)
         (copy-file from to)
       ;; The behavior of `copy-directory' differs between Emacs 23 and
       ;; 24 in that in Emacs 23, the contents of `from' is copied to
       ;; `to', while in Emacs 24 the directory `from' is copied to
       ;; `to'. We want the Emacs 24 behavior.
       (if (> emacs-major-version 23)
           (copy-directory from to)
         (if (f-dir? to)
             (progn
               (apply 'f-mkdir (f-split to))
               (let ((new-to (f-expand (f-filename from) to)))
                 (copy-directory from new-to)))
           (copy-directory from to))))))
 
 (defun f-copy-contents (from to)
   "Copy contents in directory FROM, to directory TO."
   (unless (f-exists? to)
     (error "Cannot copy contents to non existing directory %s" to))
   (unless (f-dir? from)
     (error "Cannot copy contents as %s is a file" from))
   (--each (f-entries from)
     (f-copy it (file-name-as-directory to))))
 
 (defun f-touch (path)
   "Update PATH last modification date or create if it does not exist."
   (f--destructive path
     (if (f-file? path)
         (set-file-times path)
       (f-write-bytes "" path))))
 
 
 ;;;; Predicates
 
 (defun f-exists? (path)
   "Return t if PATH exists, false otherwise."
   (file-exists-p path))
 
 (defalias 'f-exists-p 'f-exists?)
 
 (defalias 'f-dir? 'f-directory?)
 (defalias 'f-dir-p 'f-dir?)
 
 (defun f-directory? (path)
   "Return t if PATH is directory, false otherwise."
   (file-directory-p path))
 
 (defalias 'f-directory-p 'f-directory?)
 
 (defun f-file? (path)
   "Return t if PATH is file, false otherwise."
   (file-regular-p path))
 
 (defalias 'f-file-p 'f-file?)
 
 (defun f-symlink? (path)
   "Return t if PATH is symlink, false otherwise."
   (not (not (file-symlink-p path))))
 
 (defalias 'f-symlink-p 'f-symlink?)
 
 (defun f-readable? (path)
   "Return t if PATH is readable, false otherwise."
   (file-readable-p path))
 
 (defalias 'f-readable-p 'f-readable?)
 
 (defun f-writable? (path)
   "Return t if PATH is writable, false otherwise."
   (file-writable-p path))
 
 (defalias 'f-writable-p 'f-writable?)
 
 (defun f-executable? (path)
   "Return t if PATH is executable, false otherwise."
   (file-executable-p path))
 
 (defalias 'f-executable-p 'f-executable?)
 
 (defun f-absolute? (path)
   "Return t if PATH is absolute, false otherwise."
   (file-name-absolute-p path))
 
 (defalias 'f-absolute-p 'f-absolute?)
 
 (defun f-relative? (path)
   "Return t if PATH is relative, false otherwise."
   (not (f-absolute? path)))
 
 (defalias 'f-relative-p 'f-relative?)
 
 (defun f-root? (path)
   "Return t if PATH is root directory, false otherwise."
   (not (f-parent path)))
 
 (defalias 'f-root-p 'f-root?)
 
 (defun f-ext? (path &optional ext)
   "Return t if extension of PATH is EXT, false otherwise.
 
 If EXT is nil or omitted, return t if PATH has any extension,
 false otherwise.
 
 The extension, in a file name, is the part that follows the last
 '.', excluding version numbers and backup suffixes."
   (if ext
       (string= (f-ext path) ext)
     (not (eq (f-ext path) nil))))
 
 (defalias 'f-ext-p 'f-ext?)
 
 (defalias 'f-equal? 'f-same?)
 (defalias 'f-equal-p 'f-equal?)
 
 (defun f-same? (path-a path-b)
   "Return t if PATH-A and PATH-B are references to same file."
   (when (and (f-exists? path-a)
              (f-exists? path-b))
     (equal
      (f-canonical (directory-file-name (f-expand path-a)))
      (f-canonical (directory-file-name (f-expand path-b))))))
 
 (defalias 'f-same-p 'f-same?)
 
 (defun f-parent-of? (path-a path-b)
   "Return t if PATH-A is parent of PATH-B."
   (--when-let (f-parent path-b)
     (f-same? path-a it)))
 
 (defalias 'f-parent-of-p 'f-parent-of?)
 
 (defun f-child-of? (path-a path-b)
   "Return t if PATH-A is child of PATH-B."
   (--when-let (f-parent path-a)
     (f-same? it path-b)))
 
 (defalias 'f-child-of-p 'f-child-of?)
 
 (defun f-ancestor-of? (path-a path-b)
   "Return t if PATH-A is ancestor of PATH-B."
   (unless (f-same? path-a path-b)
     (s-starts-with? (f-full path-a)
                     (f-full path-b))))
 
 (defalias 'f-ancestor-of-p 'f-ancestor-of?)
 
 (defun f-descendant-of? (path-a path-b)
   "Return t if PATH-A is desendant of PATH-B."
   (unless (f-same? path-a path-b)
     (s-starts-with? (f-full path-b)
                     (f-full path-a))))
 
 (defalias 'f-descendant-of-p 'f-descendant-of?)
 
 (defun f-hidden? (path)
   "Return t if PATH is hidden, nil otherwise."
   (unless (f-exists? path)
     (error "Path does not exist: %s" path))
   (string= (substring path 0 1) "."))
 
 (defalias 'f-hidden-p 'f-hidden?)
 
 (defun f-empty? (path)
   "If PATH is a file, return t if the file in PATH is empty, nil otherwise.
 If PATH is directory, return t if directory has no files, nil otherwise."
   (if (f-directory? path)
       (equal (f-files path nil t) nil)
     (= (f-size path) 0)))
 
 (defalias 'f-empty-p 'f-empty?)
 
 
 ;;;; Stats
 
 (defun f-size (path)
   "Return size of PATH.
 
 If PATH is a file, return size of that file.  If PATH is
 directory, return sum of all files in PATH."
   (if (f-directory? path)
       (-sum (-map 'f-size (f-files path nil t)))
     (nth 7 (file-attributes path))))
 
 (defun f-depth (path)
   "Return the depth of PATH.
 
 At first, PATH is expanded with `f-expand'.  Then the full path is used to
 detect the depth.
 '/' will be zero depth,  '/usr' will be one depth.  And so on."
   (- (length (f-split (f-expand path))) 1))
 
 
 ;;;; Misc
 
 (defun f-this-file ()
   "Return path to this file."
   (cond
    (load-in-progress load-file-name)
    ((and (boundp 'byte-compile-current-file) byte-compile-current-file)
     byte-compile-current-file)
    (:else (buffer-file-name))))
 
 (defvar f--path-separator nil
   "A variable to cache result of `f-path-separator'.")
 
 (defun f-path-separator ()
   "Return path separator."
   (or f--path-separator
       (setq f--path-separator (substring (f-join "x" "y") 1 2))))
 
 (defun f-glob (pattern &optional path)
   "Find PATTERN in PATH."
   (file-expand-wildcards
    (f-join (or path default-directory) pattern)))
 
 (defun f--collect-entries (path recursive)
   (let (result
         (entries
          (-reject
           (lambda (file)
             (or
              (equal (f-filename file) ".")
              (equal (f-filename file) "..")))
           (directory-files path t))))
     (cond (recursive
            (-map
             (lambda (entry)
               (if (f-file? entry)
                   (setq result (cons entry result))
                 (when (f-directory? entry)
                   (setq result (cons entry result))
                   (setq result (append result (f--collect-entries entry recursive))))))
             entries))
           (t (setq result entries)))
     result))
 
 (defmacro f--entries (path body &optional recursive)
   "Anaphoric version of `f-entries'."
   `(f-entries
     ,path
     (lambda (path)
       (let ((it path))
         ,body))
     ,recursive))
 
 (defun f-entries (path &optional fn recursive)
   "Find all files and directories in PATH.
 
 FN - called for each found file and directory.  If FN returns a thruthy
 value, file or directory will be included.
 RECURSIVE - Search for files and directories recursive."
   (let ((entries (f--collect-entries path recursive)))
     (if fn (-select fn entries) entries)))
 
 (defmacro f--directories (path body &optional recursive)
   "Anaphoric version of `f-directories'."
   `(f-directories
     ,path
     (lambda (path)
       (let ((it path))
         ,body))
     ,recursive))
 
 (defun f-directories (path &optional fn recursive)
   "Find all directories in PATH.  See `f-entries'."
   (let ((directories (-select 'f-directory? (f--collect-entries path recursive))))
     (if fn (-select fn directories) directories)))
 
 (defmacro f--files (path body &optional recursive)
   "Anaphoric version of `f-files'."
   `(f-files
     ,path
     (lambda (path)
       (let ((it path))
         ,body))
     ,recursive))
 
 (defun f-files (path &optional fn recursive)
   "Find all files in PATH.  See `f-entries'."
   (let ((files (-select 'f-file? (f--collect-entries path recursive))))
     (if fn (-select fn files) files)))
 
 (defmacro f--traverse-upwards (body &optional path)
   "Anaphoric version of `f-traverse-upwards'."
   `(f-traverse-upwards
     (lambda (dir)
       (let ((it dir))
         ,body))
     ,path))
 
 (defun f-traverse-upwards (fn &optional path)
   "Traverse up as long as FN return nil, starting at PATH.
 
 If FN returns a non-nil value, the path sent as argument to FN is
 returned.  If no function callback return a non-nil value, nil is
 returned."
   (unless path
     (setq path default-directory))
   (when (f-relative? path)
     (setq path (f-expand path)))
   (if (funcall fn path)
       path
     (unless (f-root? path)
       (f-traverse-upwards fn (f-parent path)))))
 
 (defun f-root ()
   "Return absolute root."
   (f-traverse-upwards 'f-root?))
 
 (defmacro f-with-sandbox (path-or-paths &rest body)
   "Only allow PATH-OR-PATHS and decendants to be modified in BODY."
   (declare (indent 1))
   `(let ((paths (if (listp ,path-or-paths)
                     ,path-or-paths
                   (list ,path-or-paths))))
      (unwind-protect
          (let ((f--guard-paths paths))
            ,@body)
        (setq f--guard-paths nil))))
 
 (provide 'f)
 
 ;;; f.el ends here