29870
|
1 ;;; esh-util --- general utilities
|
|
2
|
|
3 ;; Copyright (C) 1999, 2000 Free Sofware Foundation
|
|
4
|
|
5 ;; This file is part of GNU Emacs.
|
|
6
|
|
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
8 ;; it under the terms of the GNU General Public License as published by
|
|
9 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
10 ;; any later version.
|
|
11
|
|
12 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
15 ;; GNU General Public License for more details.
|
|
16
|
|
17 ;; You should have received a copy of the GNU General Public License
|
|
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
20 ;; Boston, MA 02111-1307, USA.
|
|
21
|
|
22 (provide 'esh-util)
|
|
23
|
|
24 (eval-when-compile (require 'esh-maint))
|
|
25
|
|
26 (defgroup eshell-util nil
|
|
27 "This is general utility code, meant for use by Eshell itself."
|
|
28 :tag "General utilities"
|
|
29 :group 'eshell)
|
|
30
|
|
31 ;;; Commentary:
|
|
32
|
|
33 (require 'pp)
|
|
34
|
|
35 ;;; User Variables:
|
|
36
|
|
37 (defcustom eshell-group-file "/etc/group"
|
|
38 "*If non-nil, the name of the group file on your system."
|
|
39 :type '(choice (const :tag "No group file" nil) file)
|
|
40 :group 'eshell-util)
|
|
41
|
|
42 (defcustom eshell-passwd-file "/etc/passwd"
|
|
43 "*If non-nil, the name of the passwd file on your system."
|
|
44 :type '(choice (const :tag "No passwd file" nil) file)
|
|
45 :group 'eshell-util)
|
|
46
|
|
47 (defcustom eshell-hosts-file "/etc/hosts"
|
|
48 "*The name of the /etc/hosts file."
|
|
49 :type '(choice (const :tag "No hosts file" nil) file)
|
|
50 :group 'eshell-util)
|
|
51
|
|
52 (defcustom eshell-handle-errors t
|
|
53 "*If non-nil, Eshell will handle errors itself.
|
|
54 Setting this to nil is offered as an aid to debugging only."
|
|
55 :type 'boolean
|
|
56 :group 'eshell-util)
|
|
57
|
|
58 (defcustom eshell-private-file-modes 384 ; umask 177
|
|
59 "*The file-modes value to use for creating \"private\" files."
|
|
60 :type 'integer
|
|
61 :group 'eshell-util)
|
|
62
|
|
63 (defcustom eshell-private-directory-modes 448 ; umask 077
|
|
64 "*The file-modes value to use for creating \"private\" directories."
|
|
65 :type 'integer
|
|
66 :group 'eshell-util)
|
|
67
|
|
68 (defcustom eshell-tar-regexp
|
|
69 "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
|
|
70 "*Regular expression used to match tar file names."
|
|
71 :type 'regexp
|
|
72 :group 'eshell-util)
|
|
73
|
|
74 (defcustom eshell-convert-numeric-arguments t
|
|
75 "*If non-nil, converting arguments of numeric form to Lisp numbers.
|
|
76 Numeric form is tested using the regular expression
|
|
77 `eshell-number-regexp'."
|
|
78 :type 'boolean
|
|
79 :group 'eshell-util)
|
|
80
|
|
81 (defcustom eshell-number-regexp "\\(0\\|-?[1-9][0-9]*\\(\\.[0-9]+\\)?\\)"
|
|
82 "*Regular expression used to match numeric arguments.
|
|
83 If `eshell-convert-numeric-arguments' is non-nil, and an argument
|
|
84 matches this regexp, it will be converted to a Lisp number, using the
|
|
85 function `string-to-number'."
|
|
86 :type 'regexp
|
|
87 :group 'eshell-util)
|
|
88
|
|
89 ;;; Internal Variables:
|
|
90
|
|
91 (defvar eshell-group-names nil
|
|
92 "A cache to hold the names of groups.")
|
|
93
|
|
94 (defvar eshell-group-timestamp nil
|
|
95 "A timestamp of when the group file was read.")
|
|
96
|
|
97 (defvar eshell-user-names nil
|
|
98 "A cache to hold the names of users.")
|
|
99
|
|
100 (defvar eshell-user-timestamp nil
|
|
101 "A timestamp of when the user file was read.")
|
|
102
|
|
103 (defvar eshell-host-names nil
|
|
104 "A cache the names of frequently accessed hosts.")
|
|
105
|
|
106 (defvar eshell-host-timestamp nil
|
|
107 "A timestamp of when the hosts file was read.")
|
|
108
|
|
109 ;;; Functions:
|
|
110
|
|
111 (defsubst eshell-under-xemacs-p ()
|
|
112 "Return non-nil if we are running under XEmacs."
|
|
113 (boundp 'xemacs-logo))
|
|
114
|
|
115 (defsubst eshell-under-windows-p ()
|
|
116 "Return non-nil if we are running under MS-DOS/Windows."
|
|
117 (memq system-type '(ms-dos windows-nt)))
|
|
118
|
|
119 (defmacro eshell-condition-case (tag form &rest handlers)
|
|
120 "Like `condition-case', but only if `eshell-pass-through-errors' is nil."
|
|
121 (if eshell-handle-errors
|
|
122 `(condition-case ,tag
|
|
123 ,form
|
|
124 ,@handlers)
|
|
125 form))
|
|
126
|
|
127 (put 'eshell-condition-case 'lisp-indent-function 2)
|
|
128
|
|
129 (defmacro eshell-deftest (module name label &rest forms)
|
|
130 (if (and (fboundp 'cl-compiling-file) (cl-compiling-file))
|
|
131 nil
|
|
132 (let ((fsym (intern (concat "eshell-test--" (symbol-name name)))))
|
|
133 `(eval-when-compile
|
|
134 (ignore
|
|
135 (defun ,fsym () ,label
|
|
136 (eshell-run-test (quote ,module) (quote ,fsym) ,label
|
|
137 (quote (progn ,@forms)))))))))
|
|
138
|
|
139 (put 'eshell-deftest 'lisp-indent-function 2)
|
|
140
|
|
141 (defun eshell-find-delimiter
|
|
142 (open close &optional bound reverse-p backslash-p)
|
|
143 "From point, find the CLOSE delimiter corresponding to OPEN.
|
|
144 The matching is bounded by BOUND.
|
|
145 If REVERSE-P is non-nil, process the region backwards.
|
|
146 If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character,
|
|
147 then quoting is done by a backslash, rather than a doubled delimiter."
|
|
148 (save-excursion
|
|
149 (let ((depth 1)
|
|
150 (bound (or bound (point-max))))
|
|
151 (if (if reverse-p
|
|
152 (eq (char-before) close)
|
|
153 (eq (char-after) open))
|
|
154 (forward-char (if reverse-p -1 1)))
|
|
155 (while (and (> depth 0)
|
|
156 (funcall (if reverse-p '> '<) (point) bound))
|
|
157 (let ((c (if reverse-p (char-before) (char-after))) nc)
|
|
158 (cond ((and (not reverse-p)
|
|
159 (or (not (eq open close))
|
|
160 backslash-p)
|
|
161 (eq c ?\\)
|
|
162 (setq nc (char-after (1+ (point))))
|
|
163 (or (eq nc open) (eq nc close)))
|
|
164 (forward-char 1))
|
|
165 ((and reverse-p
|
|
166 (or (not (eq open close))
|
|
167 backslash-p)
|
|
168 (or (eq c open) (eq c close))
|
|
169 (eq (char-before (1- (point)))
|
|
170 ?\\))
|
|
171 (forward-char -1))
|
|
172 ((eq open close)
|
|
173 (if (eq c open)
|
|
174 (if (and (not backslash-p)
|
|
175 (eq (if reverse-p
|
|
176 (char-before (1- (point)))
|
|
177 (char-after (1+ (point)))) open))
|
|
178 (forward-char (if reverse-p -1 1))
|
|
179 (setq depth (1- depth)))))
|
|
180 ((= c open)
|
|
181 (setq depth (+ depth (if reverse-p -1 1))))
|
|
182 ((= c close)
|
|
183 (setq depth (+ depth (if reverse-p 1 -1))))))
|
|
184 (forward-char (if reverse-p -1 1)))
|
|
185 (if (= depth 0)
|
|
186 (if reverse-p (point) (1- (point)))))))
|
|
187
|
|
188 (defun eshell-convert (string)
|
|
189 "Convert STRING into a more native looking Lisp object."
|
|
190 (if (not (stringp string))
|
|
191 string
|
|
192 (let ((len (length string)))
|
|
193 (if (= len 0)
|
|
194 string
|
|
195 (if (eq (aref string (1- len)) ?\n)
|
|
196 (setq string (substring string 0 (1- len))))
|
|
197 (if (string-match "\n" string)
|
|
198 (split-string string "\n")
|
|
199 (if (and eshell-convert-numeric-arguments
|
|
200 (string-match
|
|
201 (concat "\\`\\s-*" eshell-number-regexp
|
|
202 "\\s-*\\'") string))
|
|
203 (string-to-number string)
|
|
204 string))))))
|
|
205
|
|
206 (defun eshell-sublist (l &optional n m)
|
|
207 "Return from LIST the N to M elements.
|
|
208 If N or M is nil, it means the end of the list."
|
|
209 (let* ((a (copy-list l))
|
|
210 result)
|
|
211 (if (and m (consp (nthcdr m a)))
|
|
212 (setcdr (nthcdr m a) nil))
|
|
213 (if n
|
|
214 (setq a (nthcdr n a))
|
|
215 (setq n (1- (length a))
|
|
216 a (last a)))
|
|
217 a))
|
|
218
|
|
219 (defun eshell-split-path (path)
|
|
220 "Split a path into multiple subparts."
|
|
221 (let ((len (length path))
|
|
222 (i 0) (li 0)
|
|
223 parts)
|
|
224 (if (and (eshell-under-windows-p)
|
|
225 (> len 2)
|
|
226 (eq (aref path 0) directory-sep-char)
|
|
227 (eq (aref path 1) directory-sep-char))
|
|
228 (setq i 2))
|
|
229 (while (< i len)
|
|
230 (if (and (eq (aref path i) directory-sep-char)
|
|
231 (not (get-text-property i 'escaped path)))
|
|
232 (setq parts (cons (if (= li i)
|
|
233 (char-to-string directory-sep-char)
|
|
234 (substring path li (1+ i))) parts)
|
|
235 li (1+ i)))
|
|
236 (setq i (1+ i)))
|
|
237 (if (< li i)
|
|
238 (setq parts (cons (substring path li i) parts)))
|
|
239 (if (and (eshell-under-windows-p)
|
|
240 (string-match "\\`[A-Za-z]:\\'" (car (last parts))))
|
|
241 (setcar (last parts)
|
|
242 (concat (car (last parts))
|
|
243 (char-to-string directory-sep-char))))
|
|
244 (nreverse parts)))
|
|
245
|
|
246 (defun eshell-to-flat-string (value)
|
|
247 "Make value a string. If separated by newlines change them to spaces."
|
|
248 (let ((text (eshell-stringify value)))
|
|
249 (if (string-match "\n+\\'" text)
|
|
250 (setq text (replace-match "" t t text)))
|
|
251 (while (string-match "\n+" text)
|
|
252 (setq text (replace-match " " t t text)))
|
|
253 text))
|
|
254
|
|
255 (defmacro eshell-for (for-var for-list &rest forms)
|
|
256 "Iterate through a list"
|
|
257 `(let ((list-iter ,for-list))
|
|
258 (while list-iter
|
|
259 (let ((,for-var (car list-iter)))
|
|
260 ,@forms)
|
|
261 (setq list-iter (cdr list-iter)))))
|
|
262
|
|
263 (put 'eshell-for 'lisp-indent-function 2)
|
|
264
|
|
265 (defun eshell-flatten-list (args)
|
|
266 "Flatten any lists within ARGS, so that there are no sublists."
|
|
267 (let ((new-list (list t)))
|
|
268 (eshell-for a args
|
|
269 (if (and (listp a)
|
|
270 (listp (cdr a)))
|
|
271 (nconc new-list (eshell-flatten-list a))
|
|
272 (nconc new-list (list a))))
|
|
273 (cdr new-list)))
|
|
274
|
|
275 (defun eshell-uniqify-list (l)
|
|
276 "Remove occurring multiples in L. You probably want to sort first."
|
|
277 (let ((m l))
|
|
278 (while m
|
|
279 (while (and (cdr m)
|
|
280 (string= (car m)
|
|
281 (cadr m)))
|
|
282 (setcdr m (cddr m)))
|
|
283 (setq m (cdr m))))
|
|
284 l)
|
|
285
|
|
286 (defun eshell-stringify (object)
|
|
287 "Convert OBJECT into a string value."
|
|
288 (cond
|
|
289 ((stringp object) object)
|
|
290 ((and (listp object)
|
|
291 (not (eq object nil)))
|
|
292 (let ((string (pp-to-string object)))
|
|
293 (substring string 0 (1- (length string)))))
|
|
294 ((numberp object)
|
|
295 (number-to-string object))
|
|
296 (t
|
|
297 (pp-to-string object))))
|
|
298
|
|
299 (defsubst eshell-stringify-list (args)
|
|
300 "Convert each element of ARGS into a string value."
|
|
301 (mapcar 'eshell-stringify args))
|
|
302
|
|
303 (defsubst eshell-flatten-and-stringify (&rest args)
|
|
304 "Flatten and stringify all of the ARGS into a single string."
|
|
305 (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
|
|
306
|
|
307 ;; the next two are from GNUS, and really should be made part of Emacs
|
|
308 ;; some day
|
|
309 (defsubst eshell-time-less-p (t1 t2)
|
|
310 "Say whether time T1 is less than time T2."
|
|
311 (or (< (car t1) (car t2))
|
|
312 (and (= (car t1) (car t2))
|
|
313 (< (nth 1 t1) (nth 1 t2)))))
|
|
314
|
|
315 (defsubst eshell-time-to-seconds (time)
|
|
316 "Convert TIME to a floating point number."
|
|
317 (+ (* (car time) 65536.0)
|
|
318 (cadr time)
|
|
319 (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
|
|
320
|
|
321 (defsubst eshell-directory-files (regexp &optional directory)
|
|
322 "Return a list of files in the given DIRECTORY matching REGEXP."
|
|
323 (directory-files (or directory default-directory)
|
|
324 directory regexp))
|
|
325
|
|
326 (defun eshell-regexp-arg (prompt)
|
|
327 "Return list of regexp and prefix arg using PROMPT."
|
|
328 (let* (;; Don't clobber this.
|
|
329 (last-command last-command)
|
|
330 (regexp (read-from-minibuffer prompt nil nil nil
|
|
331 'minibuffer-history-search-history)))
|
|
332 (list (if (string-equal regexp "")
|
|
333 (setcar minibuffer-history-search-history
|
|
334 (nth 1 minibuffer-history-search-history))
|
|
335 regexp)
|
|
336 (prefix-numeric-value current-prefix-arg))))
|
|
337
|
|
338 (defun eshell-printable-size (filesize &optional human-readable
|
|
339 block-size use-colors)
|
|
340 "Return a printable FILESIZE."
|
|
341 (let ((size (float (or filesize 0))))
|
|
342 (if human-readable
|
|
343 (if (< size human-readable)
|
|
344 (if (= (round size) 0)
|
|
345 "0"
|
|
346 (if block-size
|
|
347 "1.0k"
|
|
348 (format "%.0f" size)))
|
|
349 (setq size (/ size human-readable))
|
|
350 (if (< size human-readable)
|
|
351 (if (<= size 9.94)
|
|
352 (format "%.1fk" size)
|
|
353 (format "%.0fk" size))
|
|
354 (setq size (/ size human-readable))
|
|
355 (if (< size human-readable)
|
|
356 (let ((str (if (<= size 9.94)
|
|
357 (format "%.1fM" size)
|
|
358 (format "%.0fM" size))))
|
|
359 (if use-colors
|
|
360 (put-text-property 0 (length str)
|
|
361 'face 'bold str))
|
|
362 str)
|
|
363 (setq size (/ size human-readable))
|
|
364 (if (< size human-readable)
|
|
365 (let ((str (if (<= size 9.94)
|
|
366 (format "%.1fG" size)
|
|
367 (format "%.0fG" size))))
|
|
368 (if use-colors
|
|
369 (put-text-property 0 (length str)
|
|
370 'face 'bold-italic str))
|
|
371 str)))))
|
|
372 (if block-size
|
|
373 (setq size (/ size block-size)))
|
|
374 (format "%.0f" size))))
|
|
375
|
|
376 (defun eshell-winnow-list (entries exclude &optional predicates)
|
|
377 "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
|
|
378 The original list is not affected. If the result is only one element
|
|
379 long, it will be returned itself, rather than returning a one-element
|
|
380 list."
|
|
381 (let ((flist (list t))
|
|
382 valid p listified)
|
|
383 (unless (listp entries)
|
|
384 (setq entries (list entries)
|
|
385 listified t))
|
|
386 (eshell-for entry entries
|
|
387 (unless (and exclude (string-match exclude entry))
|
|
388 (setq p predicates valid (null p))
|
|
389 (while p
|
|
390 (if (funcall (car p) entry)
|
|
391 (setq valid t)
|
|
392 (setq p nil valid nil))
|
|
393 (setq p (cdr p)))
|
|
394 (when valid
|
|
395 (nconc flist (list entry)))))
|
|
396 (if listified
|
|
397 (cadr flist)
|
|
398 (cdr flist))))
|
|
399
|
|
400 (defsubst eshell-redisplay ()
|
|
401 "Allow Emacs to redisplay buffers."
|
|
402 ;; for some strange reason, Emacs 21 is prone to trigger an
|
|
403 ;; "args out of range" error in `sit-for', if this function
|
|
404 ;; runs while point is in the minibuffer and the users attempt
|
|
405 ;; to use completion. Don't ask me.
|
|
406 (ignore-errors (sit-for 0 0)))
|
|
407
|
|
408 (defun eshell-read-passwd-file (file)
|
|
409 "Return an alist correlating gids to group names in FILE."
|
|
410 (let (names)
|
|
411 (when (file-readable-p file)
|
|
412 (with-temp-buffer
|
|
413 (insert-file-contents file)
|
|
414 (goto-char (point-min))
|
|
415 (while (not (eobp))
|
|
416 (let* ((fields
|
|
417 (split-string (buffer-substring
|
|
418 (point) (progn (end-of-line)
|
|
419 (point))) ":")))
|
|
420 (if (and fields (nth 0 fields) (nth 2 fields))
|
|
421 (setq names (cons (cons (string-to-int (nth 2 fields))
|
|
422 (nth 0 fields))
|
|
423 names))))
|
|
424 (forward-line))))
|
|
425 names))
|
|
426
|
|
427 (defun eshell-read-passwd (file result-var timestamp-var)
|
|
428 "Read the contents of /etc/passwd for user names."
|
|
429 (if (or (not (symbol-value result-var))
|
|
430 (not (symbol-value timestamp-var))
|
|
431 (eshell-time-less-p
|
|
432 (symbol-value timestamp-var)
|
|
433 (nth 5 (file-attributes file))))
|
|
434 (progn
|
|
435 (set result-var (eshell-read-passwd-file file))
|
|
436 (set timestamp-var (current-time))))
|
|
437 (symbol-value result-var))
|
|
438
|
|
439 (defun eshell-read-group-names ()
|
|
440 "Read the contents of /etc/group for group names."
|
|
441 (if eshell-group-file
|
|
442 (eshell-read-passwd eshell-group-file 'eshell-group-names
|
|
443 'eshell-group-timestamp)))
|
|
444
|
|
445 (defsubst eshell-group-id (name)
|
|
446 "Return the user id for user NAME."
|
|
447 (car (rassoc name (eshell-read-group-names))))
|
|
448
|
|
449 (defsubst eshell-group-name (gid)
|
|
450 "Return the group name for the given GID."
|
|
451 (cdr (assoc gid (eshell-read-group-names))))
|
|
452
|
|
453 (defun eshell-read-user-names ()
|
|
454 "Read the contents of /etc/passwd for user names."
|
|
455 (if eshell-passwd-file
|
|
456 (eshell-read-passwd eshell-passwd-file 'eshell-user-names
|
|
457 'eshell-user-timestamp)))
|
|
458
|
|
459 (defsubst eshell-user-id (name)
|
|
460 "Return the user id for user NAME."
|
|
461 (car (rassoc name (eshell-read-user-names))))
|
|
462
|
|
463 (defalias 'eshell-user-name 'user-login-name)
|
|
464
|
|
465 (defun eshell-read-hosts-file (filename)
|
|
466 "Read in the hosts from the /etc/hosts file."
|
|
467 (let (hosts)
|
|
468 (with-temp-buffer
|
|
469 (insert-file-contents eshell-hosts-file)
|
|
470 (goto-char (point-min))
|
|
471 (while (re-search-forward
|
|
472 "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
|
|
473 (if (match-string 1)
|
|
474 (add-to-list 'hosts (match-string 1)))
|
|
475 (if (match-string 2)
|
|
476 (add-to-list 'hosts (match-string 2)))
|
|
477 (if (match-string 4)
|
|
478 (add-to-list 'hosts (match-string 4)))))
|
|
479 (sort hosts 'string-lessp)))
|
|
480
|
|
481 (defun eshell-read-hosts (file result-var timestamp-var)
|
|
482 "Read the contents of /etc/passwd for user names."
|
|
483 (if (or (not (symbol-value result-var))
|
|
484 (not (symbol-value timestamp-var))
|
|
485 (eshell-time-less-p
|
|
486 (symbol-value timestamp-var)
|
|
487 (nth 5 (file-attributes file))))
|
|
488 (progn
|
|
489 (set result-var (eshell-read-hosts-file file))
|
|
490 (set timestamp-var (current-time))))
|
|
491 (symbol-value result-var))
|
|
492
|
|
493 (defun eshell-read-host-names ()
|
|
494 "Read the contents of /etc/hosts for host names."
|
|
495 (if eshell-hosts-file
|
|
496 (eshell-read-hosts eshell-hosts-file 'eshell-host-names
|
|
497 'eshell-host-timestamp)))
|
|
498
|
|
499 (unless (fboundp 'line-end-position)
|
|
500 (defsubst line-end-position (&optional N)
|
|
501 (save-excursion (end-of-line N) (point))))
|
|
502
|
|
503 (unless (fboundp 'line-beginning-position)
|
|
504 (defsubst line-beginning-position (&optional N)
|
|
505 (save-excursion (beginning-of-line N) (point))))
|
|
506
|
|
507 (unless (fboundp 'subst-char-in-string)
|
|
508 (defun subst-char-in-string (fromchar tochar string &optional inplace)
|
|
509 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
|
|
510 Unless optional argument INPLACE is non-nil, return a new string."
|
|
511 (let ((i (length string))
|
|
512 (newstr (if inplace string (copy-sequence string))))
|
|
513 (while (> i 0)
|
|
514 (setq i (1- i))
|
|
515 (if (eq (aref newstr i) fromchar)
|
|
516 (aset newstr i tochar)))
|
|
517 newstr)))
|
|
518
|
|
519 (defsubst eshell-copy-environment ()
|
|
520 "Return an unrelated copy of `process-environment'."
|
|
521 (mapcar 'concat process-environment))
|
|
522
|
|
523 (defun eshell-subgroups (groupsym)
|
|
524 "Return all of the subgroups of GROUPSYM."
|
|
525 (let ((subgroups (get groupsym 'custom-group))
|
|
526 (subg (list t)))
|
|
527 (while subgroups
|
|
528 (if (eq (cadr (car subgroups)) 'custom-group)
|
|
529 (nconc subg (list (caar subgroups))))
|
|
530 (setq subgroups (cdr subgroups)))
|
|
531 (cdr subg)))
|
|
532
|
|
533 (defmacro eshell-with-file-modes (modes &rest forms)
|
|
534 "Evaluate, with file-modes set to MODES, the given FORMS."
|
|
535 `(let ((modes (default-file-modes)))
|
|
536 (set-default-file-modes ,modes)
|
|
537 (unwind-protect
|
|
538 (progn ,@forms)
|
|
539 (set-default-file-modes modes))))
|
|
540
|
|
541 (defmacro eshell-with-private-file-modes (&rest forms)
|
|
542 "Evaluate FORMS with private file modes set."
|
|
543 `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
|
|
544
|
|
545 (defsubst eshell-make-private-directory (dir &optional parents)
|
|
546 "Make DIR with file-modes set to `eshell-private-directory-modes'."
|
|
547 (eshell-with-file-modes eshell-private-directory-modes
|
|
548 (make-directory dir parents)))
|
|
549
|
|
550 (defsubst eshell-substring (string sublen)
|
|
551 "Return the beginning of STRING, up to SUBLEN bytes."
|
|
552 (if string
|
|
553 (if (> (length string) sublen)
|
|
554 (substring string 0 sublen)
|
|
555 string)))
|
|
556
|
|
557 (unless (fboundp 'directory-files-and-attributes)
|
|
558 (defun directory-files-and-attributes (dir &optional full match nosort)
|
|
559 (documentation 'directory-files)
|
|
560 (let* ((dir (expand-file-name dir))
|
|
561 (default-directory dir))
|
|
562 (mapcar
|
|
563 (function
|
|
564 (lambda (file)
|
|
565 (cons file (file-attributes file))))
|
|
566 (directory-files dir full match nosort)))))
|
|
567
|
|
568 (defun eshell-directory-files-and-attributes (dir &optional full match nosort)
|
|
569 "Make sure to use the handler for `directory-file-and-attributes'."
|
|
570 (let ((dfh (find-file-name-handler dir 'directory-files)))
|
|
571 (if (not dfh)
|
|
572 (directory-files-and-attributes dir full match nosort)
|
|
573 (let* ((files (funcall dfh 'directory-files dir full match nosort))
|
|
574 (fah (find-file-name-handler dir 'file-attributes))
|
|
575 (default-directory (expand-file-name dir)))
|
|
576 (mapcar
|
|
577 (function
|
|
578 (lambda (file)
|
|
579 (cons file (funcall fah 'file-attributes file))))
|
|
580 files)))))
|
|
581
|
|
582 (defun eshell-copy-list (list)
|
|
583 "Return a copy of a list, which may be a dotted list.
|
|
584 The elements of the list are not copied, just the list structure itself."
|
|
585 (if (consp list)
|
|
586 (let ((res nil))
|
|
587 (while (consp list) (push (pop list) res))
|
|
588 (prog1 (nreverse res) (setcdr res list)))
|
|
589 (car list)))
|
|
590
|
|
591 (defun eshell-copy-tree (tree &optional vecp)
|
|
592 "Make a copy of TREE.
|
|
593 If TREE is a cons cell, this recursively copies both its car and its cdr.
|
|
594 Contrast to copy-sequence, which copies only along the cdrs. With second
|
|
595 argument VECP, this copies vectors as well as conses."
|
|
596 (if (consp tree)
|
|
597 (let ((p (setq tree (eshell-copy-list tree))))
|
|
598 (while (consp p)
|
|
599 (if (or (consp (car p)) (and vecp (vectorp (car p))))
|
|
600 (setcar p (eshell-copy-tree (car p) vecp)))
|
|
601 (or (listp (cdr p)) (setcdr p (eshell-copy-tree (cdr p) vecp)))
|
|
602 (cl-pop p)))
|
|
603 (if (and vecp (vectorp tree))
|
|
604 (let ((i (length (setq tree (copy-sequence tree)))))
|
|
605 (while (>= (setq i (1- i)) 0)
|
|
606 (aset tree i (eshell-copy-tree (aref tree i) vecp))))))
|
|
607 tree)
|
|
608
|
|
609 ; (defun eshell-copy-file
|
|
610 ; (file newname &optional ok-if-already-exists keep-date)
|
|
611 ; "Copy FILE to NEWNAME. See docs for `copy-file'."
|
|
612 ; (let (copied)
|
|
613 ; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
|
|
614 ; (let ((front (match-string 1 file))
|
|
615 ; (back (match-string 2 file))
|
|
616 ; buffer)
|
|
617 ; (if (and front (string-match eshell-tar-regexp front)
|
|
618 ; (setq buffer (find-file-noselect front)))
|
|
619 ; (with-current-buffer buffer
|
|
620 ; (goto-char (point-min))
|
|
621 ; (if (re-search-forward (concat " " (regexp-quote back)
|
|
622 ; "$") nil t)
|
|
623 ; (progn
|
|
624 ; (tar-copy (if (file-directory-p newname)
|
|
625 ; (expand-file-name
|
|
626 ; (file-name-nondirectory back) newname)
|
|
627 ; newname))
|
|
628 ; (setq copied t))
|
|
629 ; (error "%s not found in tar file %s" back front))))))
|
|
630 ; (unless copied
|
|
631 ; (copy-file file newname ok-if-already-exists keep-date))))
|
|
632
|
|
633 ; (defun eshell-file-attributes (filename)
|
|
634 ; "Return a list of attributes of file FILENAME.
|
|
635 ; See the documentation for `file-attributes'."
|
|
636 ; (let (result)
|
|
637 ; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
|
|
638 ; (let ((front (match-string 1 filename))
|
|
639 ; (back (match-string 2 filename))
|
|
640 ; buffer)
|
|
641 ; (when (and front (string-match eshell-tar-regexp front)
|
|
642 ; (setq buffer (find-file-noselect front)))
|
|
643 ; (with-current-buffer buffer
|
|
644 ; (goto-char (point-min))
|
|
645 ; (when (re-search-forward (concat " " (regexp-quote back)
|
|
646 ; "\\s-*$") nil t)
|
|
647 ; (let* ((descrip (tar-current-descriptor))
|
|
648 ; (tokens (tar-desc-tokens descrip)))
|
|
649 ; (setq result
|
|
650 ; (list
|
|
651 ; (cond
|
|
652 ; ((eq (tar-header-link-type tokens) 5)
|
|
653 ; t)
|
|
654 ; ((eq (tar-header-link-type tokens) t)
|
|
655 ; (tar-header-link-name tokens)))
|
|
656 ; 1
|
|
657 ; (tar-header-uid tokens)
|
|
658 ; (tar-header-gid tokens)
|
|
659 ; (tar-header-date tokens)
|
|
660 ; (tar-header-date tokens)
|
|
661 ; (tar-header-date tokens)
|
|
662 ; (tar-header-size tokens)
|
|
663 ; (concat
|
|
664 ; (cond
|
|
665 ; ((eq (tar-header-link-type tokens) 5) "d")
|
|
666 ; ((eq (tar-header-link-type tokens) t) "l")
|
|
667 ; (t "-"))
|
|
668 ; (tar-grind-file-mode (tar-header-mode tokens)
|
|
669 ; (make-string 9 ? ) 0))
|
|
670 ; nil nil nil))))))))
|
|
671 ; (or result
|
|
672 ; (file-attributes filename))))
|
|
673
|
|
674 ;;; Code:
|
|
675
|
|
676 ;;; esh-util.el ends here
|