.emacs.d.git - Gitblit

Chizi123

2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8

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