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