626 lines
18 KiB
EmacsLisp
626 lines
18 KiB
EmacsLisp
;;; 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: 20191110.1357
|
||
;; Package-Commit: 1814209e2ff43cf2e6d38c4cd476218915f550fb
|
||
;; 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--write-bytes data path nil))
|
||
|
||
(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."
|
||
(f--write-bytes data path :append))
|
||
|
||
(defun f--write-bytes (data filename append)
|
||
"Write binary DATA to FILENAME.
|
||
If APPEND is non-nil, append the DATA to the existing contents."
|
||
(f--destructive filename
|
||
(unless (f-unibyte-string-p data)
|
||
(signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
|
||
(let ((coding-system-for-write 'binary)
|
||
(write-region-annotate-functions nil)
|
||
(write-region-post-annotation-function nil))
|
||
(write-region data nil filename append :silent)
|
||
nil)))
|
||
|
||
|
||
;;;; 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 descendants 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
|