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