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