mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2013 Johan Andersson
4
5 ;; Author: Johan Andersson <johan.rejeep@gmail.com>
6 ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
7 ;; Version: 0.20.0
8 ;; Package-Version: 20180106.922
9 ;; Keywords: files, directories
10 ;; URL: http://github.com/rejeep/f.el
11 ;; Package-Requires: ((s "1.7.0") (dash "2.2.0"))
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 ;;; Code:
33
34
35
36 (require 's)
37 (require 'dash)
38
39 (put 'f-guard-error 'error-conditions '(error f-guard-error))
40 (put 'f-guard-error 'error-message "Destructive operation outside sandbox")
41
42 (defvar f--guard-paths nil
43   "List of allowed paths to modify when guarded.
44
45 Do not modify this variable.")
46
47 (defmacro f--destructive (path &rest body)
48   "If PATH is allowed to be modified, yield BODY.
49
50 If PATH is not allowed to be modified, throw error."
51   (declare (indent 1))
52   `(if f--guard-paths
53        (if (--any? (or (f-same? it ,path)
54                        (f-ancestor-of? it ,path)) f--guard-paths)
55            (progn ,@body)
56          (signal 'f-guard-error (list ,path f--guard-paths)))
57      ,@body))
58
59
60 ;;;; Paths
61
62 (defun f-join (&rest args)
63   "Join ARGS to a single path."
64   (let (path (relative (f-relative? (car args))))
65     (-map
66      (lambda (arg)
67        (setq path (f-expand arg path)))
68      args)
69     (if relative (f-relative path) path)))
70
71 (defun f-split (path)
72   "Split PATH and return list containing parts."
73   (let ((parts (s-split (f-path-separator) path 'omit-nulls)))
74     (if (f-absolute? path)
75         (push (f-path-separator) parts)
76       parts)))
77
78 (defun f-expand (path &optional dir)
79   "Expand PATH relative to DIR (or `default-directory').
80 PATH and DIR can be either a directory names or directory file
81 names.  Return a directory name if PATH is a directory name, and
82 a directory file name otherwise.  File name handlers are
83 ignored."
84   (let (file-name-handler-alist)
85     (expand-file-name path dir)))
86
87 (defun f-filename (path)
88   "Return the name of PATH."
89   (file-name-nondirectory (directory-file-name path)))
90
91 (defalias 'f-parent 'f-dirname)
92 (defun f-dirname (path)
93   "Return the parent directory to PATH."
94   (let ((parent (file-name-directory
95                  (directory-file-name (f-expand path default-directory)))))
96     (unless (f-same? path parent)
97       (if (f-relative? path)
98           (f-relative parent)
99         (directory-file-name parent)))))
100
101 (defun f-common-parent (paths)
102   "Return the deepest common parent directory of PATHS."
103   (cond
104    ((not paths) nil)
105    ((not (cdr paths)) (f-parent (car paths)))
106    (:otherwise
107     (let* ((paths (-map 'f-split paths))
108            (common (caar paths))
109            (re nil))
110       (while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
111         (setq paths (-map 'cdr paths))
112         (push common re)
113         (setq common (caar paths)))
114       (cond
115        ((null re) "")
116        ((and (= (length re) 1) (f-root? (car re)))
117         (f-root))
118        (:otherwise
119         (concat (apply 'f-join (nreverse re)) "/")))))))
120
121 (defun f-ext (path)
122   "Return the file extension of PATH.
123
124 The extension, in a file name, is the part that follows the last
125 '.', excluding version numbers and backup suffixes."
126   (file-name-extension path))
127
128 (defun f-no-ext (path)
129   "Return everything but the file extension of PATH."
130   (file-name-sans-extension path))
131
132 (defun f-swap-ext (path ext)
133   "Return PATH but with EXT as the new extension.
134 EXT must not be nil or empty."
135   (if (s-blank? ext)
136       (error "Extension cannot be empty or nil")
137     (concat (f-no-ext path) "." ext)))
138
139 (defun f-base (path)
140   "Return the name of PATH, excluding the extension of file."
141   (f-no-ext (f-filename path)))
142
143 (defun f-relative (path &optional dir)
144   "Return PATH relative to DIR."
145   (file-relative-name path dir))
146
147 (defalias 'f-abbrev 'f-short)
148 (defun f-short (path)
149   "Return abbrev of PATH.  See `abbreviate-file-name'."
150   (abbreviate-file-name path))
151
152 (defun f-long (path)
153   "Return long version of PATH."
154   (f-expand path))
155
156 (defun f-canonical (path)
157   "Return the canonical name of PATH."
158   (file-truename path))
159
160 (defun f-slash (path)
161   "Append slash to PATH unless one already.
162
163 Some functions, such as `call-process' requires there to be an
164 ending slash."
165   (if (f-dir? path)
166       (file-name-as-directory path)
167     path))
168
169 (defun f-full (path)
170   "Return absolute path to PATH, with ending slash."
171   (f-slash (f-long path)))
172
173 (defun f--uniquify (paths)
174   "Helper for `f-uniquify' and `f-uniquify-alist'."
175   (let* ((files-length (length paths))
176          (uniq-filenames (--map (cons it (f-filename it)) paths))
177          (uniq-filenames-next (-group-by 'cdr uniq-filenames)))
178     (while (/= files-length (length uniq-filenames-next))
179       (setq uniq-filenames-next
180             (-group-by 'cdr
181                        (--mapcat
182                         (let ((conf-files (cdr it)))
183                           (if (> (length conf-files) 1)
184                               (--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files)
185                             conf-files))
186                         uniq-filenames-next))))
187     uniq-filenames-next))
188
189 (defun f-uniquify (files)
190   "Return unique suffixes of FILES.
191
192 This function expects no duplicate paths."
193   (-map 'car (f--uniquify files)))
194
195 (defun f-uniquify-alist (files)
196   "Return alist mapping FILES to unique suffixes of FILES.
197
198 This function expects no duplicate paths."
199   (-map 'cadr (f--uniquify files)))
200
201
202 ;;;; I/O
203
204 (defun f-read-bytes (path)
205   "Read binary data from PATH.
206
207 Return the binary data as unibyte string."
208   (with-temp-buffer
209     (set-buffer-multibyte nil)
210     (setq buffer-file-coding-system 'binary)
211     (insert-file-contents-literally path)
212     (buffer-substring-no-properties (point-min) (point-max))))
213
214 (defalias 'f-read 'f-read-text)
215 (defun f-read-text (path &optional coding)
216   "Read text with PATH, using CODING.
217
218 CODING defaults to `utf-8'.
219
220 Return the decoded text as multibyte string."
221   (decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
222
223 (defalias 'f-write 'f-write-text)
224 (defun f-write-text (text coding path)
225   "Write TEXT with CODING to PATH.
226
227 TEXT is a multibyte string.  CODING is a coding system to encode
228 TEXT with.  PATH is a file name to write to."
229   (f-write-bytes (encode-coding-string text coding) path))
230
231 (defun f-unibyte-string-p (s)
232   "Determine whether S is a unibyte string."
233   (not (multibyte-string-p s)))
234
235 (defun f-write-bytes (data path)
236   "Write binary DATA to PATH.
237
238 DATA is a unibyte string.  PATH is a file name to write to."
239   (f--destructive path
240     (unless (f-unibyte-string-p data)
241       (signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
242     (let ((file-coding-system-alist nil)
243           (coding-system-for-write 'binary))
244       (with-temp-file path
245         (setq buffer-file-coding-system 'binary)
246         (set-buffer-multibyte nil)
247         (insert data)))))
248
249 (defalias 'f-append 'f-append-text)
250 (defun f-append-text (text coding path)
251   "Append TEXT with CODING to PATH.
252
253 If PATH does not exist, it is created."
254   (f-append-bytes (encode-coding-string text coding) path))
255
256 (defun f-append-bytes (data path)
257   "Append binary DATA to PATH.
258
259 If PATH does not exist, it is created."
260   (let ((content
261          (if (f-file? path)
262              (f-read-bytes path)
263            "")))
264     (f-write-bytes (concat content data) path)))
265
266
267 ;;;; Destructive
268
269 (defun f-mkdir (&rest dirs)
270   "Create directories DIRS."
271   (let (path)
272     (-each
273         dirs
274       (lambda (dir)
275         (setq path (f-expand dir path))
276         (unless (f-directory? path)
277           (f--destructive path (make-directory path)))))))
278
279 (defun f-delete (path &optional force)
280   "Delete PATH, which can be file or directory.
281
282 If FORCE is t, a directory will be deleted recursively."
283   (f--destructive path
284     (if (or (f-file? path) (f-symlink? path))
285         (delete-file path)
286       (delete-directory path force))))
287
288 (defun f-symlink (source path)
289   "Create a symlink to SOURCE from PATH."
290   (f--destructive path (make-symbolic-link source path)))
291
292 (defun f-move (from to)
293   "Move or rename FROM to TO.
294 If TO is a directory name, move FROM into TO."
295   (f--destructive to (rename-file from to t)))
296
297 (defun f-copy (from to)
298   "Copy file or directory FROM to TO.
299 If FROM names a directory and TO is a directory name, copy FROM
300 into TO as a subdirectory."
301   (f--destructive to
302     (if (f-file? from)
303         (copy-file from to)
304       ;; The behavior of `copy-directory' differs between Emacs 23 and
305       ;; 24 in that in Emacs 23, the contents of `from' is copied to
306       ;; `to', while in Emacs 24 the directory `from' is copied to
307       ;; `to'. We want the Emacs 24 behavior.
308       (if (> emacs-major-version 23)
309           (copy-directory from to)
310         (if (f-dir? to)
311             (progn
312               (apply 'f-mkdir (f-split to))
313               (let ((new-to (f-expand (f-filename from) to)))
314                 (copy-directory from new-to)))
315           (copy-directory from to))))))
316
317 (defun f-copy-contents (from to)
318   "Copy contents in directory FROM, to directory TO."
319   (unless (f-exists? to)
320     (error "Cannot copy contents to non existing directory %s" to))
321   (unless (f-dir? from)
322     (error "Cannot copy contents as %s is a file" from))
323   (--each (f-entries from)
324     (f-copy it (file-name-as-directory to))))
325
326 (defun f-touch (path)
327   "Update PATH last modification date or create if it does not exist."
328   (f--destructive path
329     (if (f-file? path)
330         (set-file-times path)
331       (f-write-bytes "" path))))
332
333
334 ;;;; Predicates
335
336 (defun f-exists? (path)
337   "Return t if PATH exists, false otherwise."
338   (file-exists-p path))
339
340 (defalias 'f-exists-p 'f-exists?)
341
342 (defalias 'f-dir? 'f-directory?)
343 (defalias 'f-dir-p 'f-dir?)
344
345 (defun f-directory? (path)
346   "Return t if PATH is directory, false otherwise."
347   (file-directory-p path))
348
349 (defalias 'f-directory-p 'f-directory?)
350
351 (defun f-file? (path)
352   "Return t if PATH is file, false otherwise."
353   (file-regular-p path))
354
355 (defalias 'f-file-p 'f-file?)
356
357 (defun f-symlink? (path)
358   "Return t if PATH is symlink, false otherwise."
359   (not (not (file-symlink-p path))))
360
361 (defalias 'f-symlink-p 'f-symlink?)
362
363 (defun f-readable? (path)
364   "Return t if PATH is readable, false otherwise."
365   (file-readable-p path))
366
367 (defalias 'f-readable-p 'f-readable?)
368
369 (defun f-writable? (path)
370   "Return t if PATH is writable, false otherwise."
371   (file-writable-p path))
372
373 (defalias 'f-writable-p 'f-writable?)
374
375 (defun f-executable? (path)
376   "Return t if PATH is executable, false otherwise."
377   (file-executable-p path))
378
379 (defalias 'f-executable-p 'f-executable?)
380
381 (defun f-absolute? (path)
382   "Return t if PATH is absolute, false otherwise."
383   (file-name-absolute-p path))
384
385 (defalias 'f-absolute-p 'f-absolute?)
386
387 (defun f-relative? (path)
388   "Return t if PATH is relative, false otherwise."
389   (not (f-absolute? path)))
390
391 (defalias 'f-relative-p 'f-relative?)
392
393 (defun f-root? (path)
394   "Return t if PATH is root directory, false otherwise."
395   (not (f-parent path)))
396
397 (defalias 'f-root-p 'f-root?)
398
399 (defun f-ext? (path &optional ext)
400   "Return t if extension of PATH is EXT, false otherwise.
401
402 If EXT is nil or omitted, return t if PATH has any extension,
403 false otherwise.
404
405 The extension, in a file name, is the part that follows the last
406 '.', excluding version numbers and backup suffixes."
407   (if ext
408       (string= (f-ext path) ext)
409     (not (eq (f-ext path) nil))))
410
411 (defalias 'f-ext-p 'f-ext?)
412
413 (defalias 'f-equal? 'f-same?)
414 (defalias 'f-equal-p 'f-equal?)
415
416 (defun f-same? (path-a path-b)
417   "Return t if PATH-A and PATH-B are references to same file."
418   (when (and (f-exists? path-a)
419              (f-exists? path-b))
420     (equal
421      (f-canonical (directory-file-name (f-expand path-a)))
422      (f-canonical (directory-file-name (f-expand path-b))))))
423
424 (defalias 'f-same-p 'f-same?)
425
426 (defun f-parent-of? (path-a path-b)
427   "Return t if PATH-A is parent of PATH-B."
428   (--when-let (f-parent path-b)
429     (f-same? path-a it)))
430
431 (defalias 'f-parent-of-p 'f-parent-of?)
432
433 (defun f-child-of? (path-a path-b)
434   "Return t if PATH-A is child of PATH-B."
435   (--when-let (f-parent path-a)
436     (f-same? it path-b)))
437
438 (defalias 'f-child-of-p 'f-child-of?)
439
440 (defun f-ancestor-of? (path-a path-b)
441   "Return t if PATH-A is ancestor of PATH-B."
442   (unless (f-same? path-a path-b)
443     (s-starts-with? (f-full path-a)
444                     (f-full path-b))))
445
446 (defalias 'f-ancestor-of-p 'f-ancestor-of?)
447
448 (defun f-descendant-of? (path-a path-b)
449   "Return t if PATH-A is desendant of PATH-B."
450   (unless (f-same? path-a path-b)
451     (s-starts-with? (f-full path-b)
452                     (f-full path-a))))
453
454 (defalias 'f-descendant-of-p 'f-descendant-of?)
455
456 (defun f-hidden? (path)
457   "Return t if PATH is hidden, nil otherwise."
458   (unless (f-exists? path)
459     (error "Path does not exist: %s" path))
460   (string= (substring path 0 1) "."))
461
462 (defalias 'f-hidden-p 'f-hidden?)
463
464 (defun f-empty? (path)
465   "If PATH is a file, return t if the file in PATH is empty, nil otherwise.
466 If PATH is directory, return t if directory has no files, nil otherwise."
467   (if (f-directory? path)
468       (equal (f-files path nil t) nil)
469     (= (f-size path) 0)))
470
471 (defalias 'f-empty-p 'f-empty?)
472
473
474 ;;;; Stats
475
476 (defun f-size (path)
477   "Return size of PATH.
478
479 If PATH is a file, return size of that file.  If PATH is
480 directory, return sum of all files in PATH."
481   (if (f-directory? path)
482       (-sum (-map 'f-size (f-files path nil t)))
483     (nth 7 (file-attributes path))))
484
485 (defun f-depth (path)
486   "Return the depth of PATH.
487
488 At first, PATH is expanded with `f-expand'.  Then the full path is used to
489 detect the depth.
490 '/' will be zero depth,  '/usr' will be one depth.  And so on."
491   (- (length (f-split (f-expand path))) 1))
492
493
494 ;;;; Misc
495
496 (defun f-this-file ()
497   "Return path to this file."
498   (cond
499    (load-in-progress load-file-name)
500    ((and (boundp 'byte-compile-current-file) byte-compile-current-file)
501     byte-compile-current-file)
502    (:else (buffer-file-name))))
503
504 (defvar f--path-separator nil
505   "A variable to cache result of `f-path-separator'.")
506
507 (defun f-path-separator ()
508   "Return path separator."
509   (or f--path-separator
510       (setq f--path-separator (substring (f-join "x" "y") 1 2))))
511
512 (defun f-glob (pattern &optional path)
513   "Find PATTERN in PATH."
514   (file-expand-wildcards
515    (f-join (or path default-directory) pattern)))
516
517 (defun f--collect-entries (path recursive)
518   (let (result
519         (entries
520          (-reject
521           (lambda (file)
522             (or
523              (equal (f-filename file) ".")
524              (equal (f-filename file) "..")))
525           (directory-files path t))))
526     (cond (recursive
527            (-map
528             (lambda (entry)
529               (if (f-file? entry)
530                   (setq result (cons entry result))
531                 (when (f-directory? entry)
532                   (setq result (cons entry result))
533                   (setq result (append result (f--collect-entries entry recursive))))))
534             entries))
535           (t (setq result entries)))
536     result))
537
538 (defmacro f--entries (path body &optional recursive)
539   "Anaphoric version of `f-entries'."
540   `(f-entries
541     ,path
542     (lambda (path)
543       (let ((it path))
544         ,body))
545     ,recursive))
546
547 (defun f-entries (path &optional fn recursive)
548   "Find all files and directories in PATH.
549
550 FN - called for each found file and directory.  If FN returns a thruthy
551 value, file or directory will be included.
552 RECURSIVE - Search for files and directories recursive."
553   (let ((entries (f--collect-entries path recursive)))
554     (if fn (-select fn entries) entries)))
555
556 (defmacro f--directories (path body &optional recursive)
557   "Anaphoric version of `f-directories'."
558   `(f-directories
559     ,path
560     (lambda (path)
561       (let ((it path))
562         ,body))
563     ,recursive))
564
565 (defun f-directories (path &optional fn recursive)
566   "Find all directories in PATH.  See `f-entries'."
567   (let ((directories (-select 'f-directory? (f--collect-entries path recursive))))
568     (if fn (-select fn directories) directories)))
569
570 (defmacro f--files (path body &optional recursive)
571   "Anaphoric version of `f-files'."
572   `(f-files
573     ,path
574     (lambda (path)
575       (let ((it path))
576         ,body))
577     ,recursive))
578
579 (defun f-files (path &optional fn recursive)
580   "Find all files in PATH.  See `f-entries'."
581   (let ((files (-select 'f-file? (f--collect-entries path recursive))))
582     (if fn (-select fn files) files)))
583
584 (defmacro f--traverse-upwards (body &optional path)
585   "Anaphoric version of `f-traverse-upwards'."
586   `(f-traverse-upwards
587     (lambda (dir)
588       (let ((it dir))
589         ,body))
590     ,path))
591
592 (defun f-traverse-upwards (fn &optional path)
593   "Traverse up as long as FN return nil, starting at PATH.
594
595 If FN returns a non-nil value, the path sent as argument to FN is
596 returned.  If no function callback return a non-nil value, nil is
597 returned."
598   (unless path
599     (setq path default-directory))
600   (when (f-relative? path)
601     (setq path (f-expand path)))
602   (if (funcall fn path)
603       path
604     (unless (f-root? path)
605       (f-traverse-upwards fn (f-parent path)))))
606
607 (defun f-root ()
608   "Return absolute root."
609   (f-traverse-upwards 'f-root?))
610
611 (defmacro f-with-sandbox (path-or-paths &rest body)
612   "Only allow PATH-OR-PATHS and decendants to be modified in BODY."
613   (declare (indent 1))
614   `(let ((paths (if (listp ,path-or-paths)
615                     ,path-or-paths
616                   (list ,path-or-paths))))
617      (unwind-protect
618          (let ((f--guard-paths paths))
619            ,@body)
620        (setq f--guard-paths nil))))
621
622 (provide 'f)
623
624 ;;; f.el ends here