Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

624 lines
18 KiB

пре 4 година
  1. ;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2013 Johan Andersson
  3. ;; Author: Johan Andersson <johan.rejeep@gmail.com>
  4. ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
  5. ;; Version: 0.20.0
  6. ;; Package-Version: 20190109.906
  7. ;; Keywords: files, directories
  8. ;; URL: http://github.com/rejeep/f.el
  9. ;; Package-Requires: ((s "1.7.0") (dash "2.2.0"))
  10. ;; This file is NOT part of GNU Emacs.
  11. ;;; License:
  12. ;; This program is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 3, or (at your option)
  15. ;; any later version.
  16. ;; This program is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;; GNU General Public License for more details.
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  22. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23. ;; Boston, MA 02110-1301, USA.
  24. ;;; Code:
  25. (require 's)
  26. (require 'dash)
  27. (put 'f-guard-error 'error-conditions '(error f-guard-error))
  28. (put 'f-guard-error 'error-message "Destructive operation outside sandbox")
  29. (defvar f--guard-paths nil
  30. "List of allowed paths to modify when guarded.
  31. Do not modify this variable.")
  32. (defmacro f--destructive (path &rest body)
  33. "If PATH is allowed to be modified, yield BODY.
  34. If PATH is not allowed to be modified, throw error."
  35. (declare (indent 1))
  36. `(if f--guard-paths
  37. (if (--any? (or (f-same? it ,path)
  38. (f-ancestor-of? it ,path)) f--guard-paths)
  39. (progn ,@body)
  40. (signal 'f-guard-error (list ,path f--guard-paths)))
  41. ,@body))
  42. ;;;; Paths
  43. (defun f-join (&rest args)
  44. "Join ARGS to a single path."
  45. (let (path (relative (f-relative? (car args))))
  46. (-map
  47. (lambda (arg)
  48. (setq path (f-expand arg path)))
  49. args)
  50. (if relative (f-relative path) path)))
  51. (defun f-split (path)
  52. "Split PATH and return list containing parts."
  53. (let ((parts (s-split (f-path-separator) path 'omit-nulls)))
  54. (if (f-absolute? path)
  55. (push (f-path-separator) parts)
  56. parts)))
  57. (defun f-expand (path &optional dir)
  58. "Expand PATH relative to DIR (or `default-directory').
  59. PATH and DIR can be either a directory names or directory file
  60. names. Return a directory name if PATH is a directory name, and
  61. a directory file name otherwise. File name handlers are
  62. ignored."
  63. (let (file-name-handler-alist)
  64. (expand-file-name path dir)))
  65. (defun f-filename (path)
  66. "Return the name of PATH."
  67. (file-name-nondirectory (directory-file-name path)))
  68. (defalias 'f-parent 'f-dirname)
  69. (defun f-dirname (path)
  70. "Return the parent directory to PATH."
  71. (let ((parent (file-name-directory
  72. (directory-file-name (f-expand path default-directory)))))
  73. (unless (f-same? path parent)
  74. (if (f-relative? path)
  75. (f-relative parent)
  76. (directory-file-name parent)))))
  77. (defun f-common-parent (paths)
  78. "Return the deepest common parent directory of PATHS."
  79. (cond
  80. ((not paths) nil)
  81. ((not (cdr paths)) (f-parent (car paths)))
  82. (:otherwise
  83. (let* ((paths (-map 'f-split paths))
  84. (common (caar paths))
  85. (re nil))
  86. (while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
  87. (setq paths (-map 'cdr paths))
  88. (push common re)
  89. (setq common (caar paths)))
  90. (cond
  91. ((null re) "")
  92. ((and (= (length re) 1) (f-root? (car re)))
  93. (f-root))
  94. (:otherwise
  95. (concat (apply 'f-join (nreverse re)) "/")))))))
  96. (defun f-ext (path)
  97. "Return the file extension of PATH.
  98. The extension, in a file name, is the part that follows the last
  99. '.', excluding version numbers and backup suffixes."
  100. (file-name-extension path))
  101. (defun f-no-ext (path)
  102. "Return everything but the file extension of PATH."
  103. (file-name-sans-extension path))
  104. (defun f-swap-ext (path ext)
  105. "Return PATH but with EXT as the new extension.
  106. EXT must not be nil or empty."
  107. (if (s-blank? ext)
  108. (error "Extension cannot be empty or nil")
  109. (concat (f-no-ext path) "." ext)))
  110. (defun f-base (path)
  111. "Return the name of PATH, excluding the extension of file."
  112. (f-no-ext (f-filename path)))
  113. (defun f-relative (path &optional dir)
  114. "Return PATH relative to DIR."
  115. (file-relative-name path dir))
  116. (defalias 'f-abbrev 'f-short)
  117. (defun f-short (path)
  118. "Return abbrev of PATH. See `abbreviate-file-name'."
  119. (abbreviate-file-name path))
  120. (defun f-long (path)
  121. "Return long version of PATH."
  122. (f-expand path))
  123. (defun f-canonical (path)
  124. "Return the canonical name of PATH."
  125. (file-truename path))
  126. (defun f-slash (path)
  127. "Append slash to PATH unless one already.
  128. Some functions, such as `call-process' requires there to be an
  129. ending slash."
  130. (if (f-dir? path)
  131. (file-name-as-directory path)
  132. path))
  133. (defun f-full (path)
  134. "Return absolute path to PATH, with ending slash."
  135. (f-slash (f-long path)))
  136. (defun f--uniquify (paths)
  137. "Helper for `f-uniquify' and `f-uniquify-alist'."
  138. (let* ((files-length (length paths))
  139. (uniq-filenames (--map (cons it (f-filename it)) paths))
  140. (uniq-filenames-next (-group-by 'cdr uniq-filenames)))
  141. (while (/= files-length (length uniq-filenames-next))
  142. (setq uniq-filenames-next
  143. (-group-by 'cdr
  144. (--mapcat
  145. (let ((conf-files (cdr it)))
  146. (if (> (length conf-files) 1)
  147. (--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files)
  148. conf-files))
  149. uniq-filenames-next))))
  150. uniq-filenames-next))
  151. (defun f-uniquify (files)
  152. "Return unique suffixes of FILES.
  153. This function expects no duplicate paths."
  154. (-map 'car (f--uniquify files)))
  155. (defun f-uniquify-alist (files)
  156. "Return alist mapping FILES to unique suffixes of FILES.
  157. This function expects no duplicate paths."
  158. (-map 'cadr (f--uniquify files)))
  159. ;;;; I/O
  160. (defun f-read-bytes (path)
  161. "Read binary data from PATH.
  162. Return the binary data as unibyte string."
  163. (with-temp-buffer
  164. (set-buffer-multibyte nil)
  165. (setq buffer-file-coding-system 'binary)
  166. (insert-file-contents-literally path)
  167. (buffer-substring-no-properties (point-min) (point-max))))
  168. (defalias 'f-read 'f-read-text)
  169. (defun f-read-text (path &optional coding)
  170. "Read text with PATH, using CODING.
  171. CODING defaults to `utf-8'.
  172. Return the decoded text as multibyte string."
  173. (decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
  174. (defalias 'f-write 'f-write-text)
  175. (defun f-write-text (text coding path)
  176. "Write TEXT with CODING to PATH.
  177. TEXT is a multibyte string. CODING is a coding system to encode
  178. TEXT with. PATH is a file name to write to."
  179. (f-write-bytes (encode-coding-string text coding) path))
  180. (defun f-unibyte-string-p (s)
  181. "Determine whether S is a unibyte string."
  182. (not (multibyte-string-p s)))
  183. (defun f-write-bytes (data path)
  184. "Write binary DATA to PATH.
  185. DATA is a unibyte string. PATH is a file name to write to."
  186. (f--write-bytes data path nil))
  187. (defalias 'f-append 'f-append-text)
  188. (defun f-append-text (text coding path)
  189. "Append TEXT with CODING to PATH.
  190. If PATH does not exist, it is created."
  191. (f-append-bytes (encode-coding-string text coding) path))
  192. (defun f-append-bytes (data path)
  193. "Append binary DATA to PATH.
  194. If PATH does not exist, it is created."
  195. (f--write-bytes data path :append))
  196. (defun f--write-bytes (data filename append)
  197. "Write binary DATA to FILENAME.
  198. If APPEND is non-nil, append the DATA to the existing contents."
  199. (f--destructive filename
  200. (unless (f-unibyte-string-p data)
  201. (signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
  202. (let ((coding-system-for-write 'binary)
  203. (write-region-annotate-functions nil)
  204. (write-region-post-annotation-function nil))
  205. (write-region data nil filename append :silent)
  206. nil)))
  207. ;;;; Destructive
  208. (defun f-mkdir (&rest dirs)
  209. "Create directories DIRS."
  210. (let (path)
  211. (-each
  212. dirs
  213. (lambda (dir)
  214. (setq path (f-expand dir path))
  215. (unless (f-directory? path)
  216. (f--destructive path (make-directory path)))))))
  217. (defun f-delete (path &optional force)
  218. "Delete PATH, which can be file or directory.
  219. If FORCE is t, a directory will be deleted recursively."
  220. (f--destructive path
  221. (if (or (f-file? path) (f-symlink? path))
  222. (delete-file path)
  223. (delete-directory path force))))
  224. (defun f-symlink (source path)
  225. "Create a symlink to SOURCE from PATH."
  226. (f--destructive path (make-symbolic-link source path)))
  227. (defun f-move (from to)
  228. "Move or rename FROM to TO.
  229. If TO is a directory name, move FROM into TO."
  230. (f--destructive to (rename-file from to t)))
  231. (defun f-copy (from to)
  232. "Copy file or directory FROM to TO.
  233. If FROM names a directory and TO is a directory name, copy FROM
  234. into TO as a subdirectory."
  235. (f--destructive to
  236. (if (f-file? from)
  237. (copy-file from to)
  238. ;; The behavior of `copy-directory' differs between Emacs 23 and
  239. ;; 24 in that in Emacs 23, the contents of `from' is copied to
  240. ;; `to', while in Emacs 24 the directory `from' is copied to
  241. ;; `to'. We want the Emacs 24 behavior.
  242. (if (> emacs-major-version 23)
  243. (copy-directory from to)
  244. (if (f-dir? to)
  245. (progn
  246. (apply 'f-mkdir (f-split to))
  247. (let ((new-to (f-expand (f-filename from) to)))
  248. (copy-directory from new-to)))
  249. (copy-directory from to))))))
  250. (defun f-copy-contents (from to)
  251. "Copy contents in directory FROM, to directory TO."
  252. (unless (f-exists? to)
  253. (error "Cannot copy contents to non existing directory %s" to))
  254. (unless (f-dir? from)
  255. (error "Cannot copy contents as %s is a file" from))
  256. (--each (f-entries from)
  257. (f-copy it (file-name-as-directory to))))
  258. (defun f-touch (path)
  259. "Update PATH last modification date or create if it does not exist."
  260. (f--destructive path
  261. (if (f-file? path)
  262. (set-file-times path)
  263. (f-write-bytes "" path))))
  264. ;;;; Predicates
  265. (defun f-exists? (path)
  266. "Return t if PATH exists, false otherwise."
  267. (file-exists-p path))
  268. (defalias 'f-exists-p 'f-exists?)
  269. (defalias 'f-dir? 'f-directory?)
  270. (defalias 'f-dir-p 'f-dir?)
  271. (defun f-directory? (path)
  272. "Return t if PATH is directory, false otherwise."
  273. (file-directory-p path))
  274. (defalias 'f-directory-p 'f-directory?)
  275. (defun f-file? (path)
  276. "Return t if PATH is file, false otherwise."
  277. (file-regular-p path))
  278. (defalias 'f-file-p 'f-file?)
  279. (defun f-symlink? (path)
  280. "Return t if PATH is symlink, false otherwise."
  281. (not (not (file-symlink-p path))))
  282. (defalias 'f-symlink-p 'f-symlink?)
  283. (defun f-readable? (path)
  284. "Return t if PATH is readable, false otherwise."
  285. (file-readable-p path))
  286. (defalias 'f-readable-p 'f-readable?)
  287. (defun f-writable? (path)
  288. "Return t if PATH is writable, false otherwise."
  289. (file-writable-p path))
  290. (defalias 'f-writable-p 'f-writable?)
  291. (defun f-executable? (path)
  292. "Return t if PATH is executable, false otherwise."
  293. (file-executable-p path))
  294. (defalias 'f-executable-p 'f-executable?)
  295. (defun f-absolute? (path)
  296. "Return t if PATH is absolute, false otherwise."
  297. (file-name-absolute-p path))
  298. (defalias 'f-absolute-p 'f-absolute?)
  299. (defun f-relative? (path)
  300. "Return t if PATH is relative, false otherwise."
  301. (not (f-absolute? path)))
  302. (defalias 'f-relative-p 'f-relative?)
  303. (defun f-root? (path)
  304. "Return t if PATH is root directory, false otherwise."
  305. (not (f-parent path)))
  306. (defalias 'f-root-p 'f-root?)
  307. (defun f-ext? (path &optional ext)
  308. "Return t if extension of PATH is EXT, false otherwise.
  309. If EXT is nil or omitted, return t if PATH has any extension,
  310. false otherwise.
  311. The extension, in a file name, is the part that follows the last
  312. '.', excluding version numbers and backup suffixes."
  313. (if ext
  314. (string= (f-ext path) ext)
  315. (not (eq (f-ext path) nil))))
  316. (defalias 'f-ext-p 'f-ext?)
  317. (defalias 'f-equal? 'f-same?)
  318. (defalias 'f-equal-p 'f-equal?)
  319. (defun f-same? (path-a path-b)
  320. "Return t if PATH-A and PATH-B are references to same file."
  321. (when (and (f-exists? path-a)
  322. (f-exists? path-b))
  323. (equal
  324. (f-canonical (directory-file-name (f-expand path-a)))
  325. (f-canonical (directory-file-name (f-expand path-b))))))
  326. (defalias 'f-same-p 'f-same?)
  327. (defun f-parent-of? (path-a path-b)
  328. "Return t if PATH-A is parent of PATH-B."
  329. (--when-let (f-parent path-b)
  330. (f-same? path-a it)))
  331. (defalias 'f-parent-of-p 'f-parent-of?)
  332. (defun f-child-of? (path-a path-b)
  333. "Return t if PATH-A is child of PATH-B."
  334. (--when-let (f-parent path-a)
  335. (f-same? it path-b)))
  336. (defalias 'f-child-of-p 'f-child-of?)
  337. (defun f-ancestor-of? (path-a path-b)
  338. "Return t if PATH-A is ancestor of PATH-B."
  339. (unless (f-same? path-a path-b)
  340. (s-starts-with? (f-full path-a)
  341. (f-full path-b))))
  342. (defalias 'f-ancestor-of-p 'f-ancestor-of?)
  343. (defun f-descendant-of? (path-a path-b)
  344. "Return t if PATH-A is desendant of PATH-B."
  345. (unless (f-same? path-a path-b)
  346. (s-starts-with? (f-full path-b)
  347. (f-full path-a))))
  348. (defalias 'f-descendant-of-p 'f-descendant-of?)
  349. (defun f-hidden? (path)
  350. "Return t if PATH is hidden, nil otherwise."
  351. (unless (f-exists? path)
  352. (error "Path does not exist: %s" path))
  353. (string= (substring path 0 1) "."))
  354. (defalias 'f-hidden-p 'f-hidden?)
  355. (defun f-empty? (path)
  356. "If PATH is a file, return t if the file in PATH is empty, nil otherwise.
  357. If PATH is directory, return t if directory has no files, nil otherwise."
  358. (if (f-directory? path)
  359. (equal (f-files path nil t) nil)
  360. (= (f-size path) 0)))
  361. (defalias 'f-empty-p 'f-empty?)
  362. ;;;; Stats
  363. (defun f-size (path)
  364. "Return size of PATH.
  365. If PATH is a file, return size of that file. If PATH is
  366. directory, return sum of all files in PATH."
  367. (if (f-directory? path)
  368. (-sum (-map 'f-size (f-files path nil t)))
  369. (nth 7 (file-attributes path))))
  370. (defun f-depth (path)
  371. "Return the depth of PATH.
  372. At first, PATH is expanded with `f-expand'. Then the full path is used to
  373. detect the depth.
  374. '/' will be zero depth, '/usr' will be one depth. And so on."
  375. (- (length (f-split (f-expand path))) 1))
  376. ;;;; Misc
  377. (defun f-this-file ()
  378. "Return path to this file."
  379. (cond
  380. (load-in-progress load-file-name)
  381. ((and (boundp 'byte-compile-current-file) byte-compile-current-file)
  382. byte-compile-current-file)
  383. (:else (buffer-file-name))))
  384. (defvar f--path-separator nil
  385. "A variable to cache result of `f-path-separator'.")
  386. (defun f-path-separator ()
  387. "Return path separator."
  388. (or f--path-separator
  389. (setq f--path-separator (substring (f-join "x" "y") 1 2))))
  390. (defun f-glob (pattern &optional path)
  391. "Find PATTERN in PATH."
  392. (file-expand-wildcards
  393. (f-join (or path default-directory) pattern)))
  394. (defun f--collect-entries (path recursive)
  395. (let (result
  396. (entries
  397. (-reject
  398. (lambda (file)
  399. (or
  400. (equal (f-filename file) ".")
  401. (equal (f-filename file) "..")))
  402. (directory-files path t))))
  403. (cond (recursive
  404. (-map
  405. (lambda (entry)
  406. (if (f-file? entry)
  407. (setq result (cons entry result))
  408. (when (f-directory? entry)
  409. (setq result (cons entry result))
  410. (setq result (append result (f--collect-entries entry recursive))))))
  411. entries))
  412. (t (setq result entries)))
  413. result))
  414. (defmacro f--entries (path body &optional recursive)
  415. "Anaphoric version of `f-entries'."
  416. `(f-entries
  417. ,path
  418. (lambda (path)
  419. (let ((it path))
  420. ,body))
  421. ,recursive))
  422. (defun f-entries (path &optional fn recursive)
  423. "Find all files and directories in PATH.
  424. FN - called for each found file and directory. If FN returns a thruthy
  425. value, file or directory will be included.
  426. RECURSIVE - Search for files and directories recursive."
  427. (let ((entries (f--collect-entries path recursive)))
  428. (if fn (-select fn entries) entries)))
  429. (defmacro f--directories (path body &optional recursive)
  430. "Anaphoric version of `f-directories'."
  431. `(f-directories
  432. ,path
  433. (lambda (path)
  434. (let ((it path))
  435. ,body))
  436. ,recursive))
  437. (defun f-directories (path &optional fn recursive)
  438. "Find all directories in PATH. See `f-entries'."
  439. (let ((directories (-select 'f-directory? (f--collect-entries path recursive))))
  440. (if fn (-select fn directories) directories)))
  441. (defmacro f--files (path body &optional recursive)
  442. "Anaphoric version of `f-files'."
  443. `(f-files
  444. ,path
  445. (lambda (path)
  446. (let ((it path))
  447. ,body))
  448. ,recursive))
  449. (defun f-files (path &optional fn recursive)
  450. "Find all files in PATH. See `f-entries'."
  451. (let ((files (-select 'f-file? (f--collect-entries path recursive))))
  452. (if fn (-select fn files) files)))
  453. (defmacro f--traverse-upwards (body &optional path)
  454. "Anaphoric version of `f-traverse-upwards'."
  455. `(f-traverse-upwards
  456. (lambda (dir)
  457. (let ((it dir))
  458. ,body))
  459. ,path))
  460. (defun f-traverse-upwards (fn &optional path)
  461. "Traverse up as long as FN return nil, starting at PATH.
  462. If FN returns a non-nil value, the path sent as argument to FN is
  463. returned. If no function callback return a non-nil value, nil is
  464. returned."
  465. (unless path
  466. (setq path default-directory))
  467. (when (f-relative? path)
  468. (setq path (f-expand path)))
  469. (if (funcall fn path)
  470. path
  471. (unless (f-root? path)
  472. (f-traverse-upwards fn (f-parent path)))))
  473. (defun f-root ()
  474. "Return absolute root."
  475. (f-traverse-upwards 'f-root?))
  476. (defmacro f-with-sandbox (path-or-paths &rest body)
  477. "Only allow PATH-OR-PATHS and decendants to be modified in BODY."
  478. (declare (indent 1))
  479. `(let ((paths (if (listp ,path-or-paths)
  480. ,path-or-paths
  481. (list ,path-or-paths))))
  482. (unwind-protect
  483. (let ((f--guard-paths paths))
  484. ,@body)
  485. (setq f--guard-paths nil))))
  486. (provide 'f)
  487. ;;; f.el ends here