Make save-some-buffers message more informative (Bug#8134).
[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
288(defmacro eshell-for (for-var for-list &rest forms)
289 "Iterate through a list"
290 `(let ((list-iter ,for-list))
291 (while list-iter
292 (let ((,for-var (car list-iter)))
293 ,@forms)
294 (setq list-iter (cdr list-iter)))))
295
296(put 'eshell-for 'lisp-indent-function 2)
297
a9eeff78
GM
298(make-obsolete 'eshell-for 'dolist "24.1")
299
ca7aae91 300(defun eshell-flatten-list (args)
26b4dc84
GM
301 "Flatten any lists within ARGS, so that there are no sublists."
302 (let ((new-list (list t)))
a9eeff78 303 (dolist (a args)
3bab4a46 304 (if (and (listp a)
26b4dc84
GM
305 (listp (cdr a)))
306 (nconc new-list (eshell-flatten-list a))
307 (nconc new-list (list a))))
308 (cdr new-list)))
309
310(defun eshell-uniqify-list (l)
311 "Remove occurring multiples in L. You probably want to sort first."
312 (let ((m l))
313 (while m
314 (while (and (cdr m)
315 (string= (car m)
316 (cadr m)))
317 (setcdr m (cddr m)))
318 (setq m (cdr m))))
319 l)
320
321(defun eshell-stringify (object)
322 "Convert OBJECT into a string value."
323 (cond
324 ((stringp object) object)
325 ((and (listp object)
326 (not (eq object nil)))
327 (let ((string (pp-to-string object)))
328 (substring string 0 (1- (length string)))))
329 ((numberp object)
330 (number-to-string object))
331 (t
dace60cf
JW
332 (unless (and (eq object t)
333 (not eshell-stringify-t))
334 (pp-to-string object)))))
26b4dc84
GM
335
336(defsubst eshell-stringify-list (args)
337 "Convert each element of ARGS into a string value."
338 (mapcar 'eshell-stringify args))
339
340(defsubst eshell-flatten-and-stringify (&rest args)
341 "Flatten and stringify all of the ARGS into a single string."
342 (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
343
26b4dc84
GM
344(defsubst eshell-directory-files (regexp &optional directory)
345 "Return a list of files in the given DIRECTORY matching REGEXP."
346 (directory-files (or directory default-directory)
347 directory regexp))
348
349(defun eshell-regexp-arg (prompt)
350 "Return list of regexp and prefix arg using PROMPT."
351 (let* (;; Don't clobber this.
352 (last-command last-command)
353 (regexp (read-from-minibuffer prompt nil nil nil
354 'minibuffer-history-search-history)))
355 (list (if (string-equal regexp "")
356 (setcar minibuffer-history-search-history
357 (nth 1 minibuffer-history-search-history))
358 regexp)
359 (prefix-numeric-value current-prefix-arg))))
360
361(defun eshell-printable-size (filesize &optional human-readable
362 block-size use-colors)
363 "Return a printable FILESIZE."
364 (let ((size (float (or filesize 0))))
365 (if human-readable
366 (if (< size human-readable)
367 (if (= (round size) 0)
368 "0"
369 (if block-size
370 "1.0k"
371 (format "%.0f" size)))
372 (setq size (/ size human-readable))
373 (if (< size human-readable)
374 (if (<= size 9.94)
375 (format "%.1fk" size)
376 (format "%.0fk" size))
377 (setq size (/ size human-readable))
378 (if (< size human-readable)
379 (let ((str (if (<= size 9.94)
380 (format "%.1fM" size)
381 (format "%.0fM" size))))
382 (if use-colors
383 (put-text-property 0 (length str)
384 'face 'bold str))
385 str)
386 (setq size (/ size human-readable))
387 (if (< size human-readable)
388 (let ((str (if (<= size 9.94)
389 (format "%.1fG" size)
390 (format "%.0fG" size))))
391 (if use-colors
392 (put-text-property 0 (length str)
393 'face 'bold-italic str))
394 str)))))
395 (if block-size
396 (setq size (/ size block-size)))
397 (format "%.0f" size))))
398
399(defun eshell-winnow-list (entries exclude &optional predicates)
400 "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
401The original list is not affected. If the result is only one element
402long, it will be returned itself, rather than returning a one-element
403list."
404 (let ((flist (list t))
405 valid p listified)
406 (unless (listp entries)
407 (setq entries (list entries)
408 listified t))
a9eeff78 409 (dolist (entry entries)
26b4dc84
GM
410 (unless (and exclude (string-match exclude entry))
411 (setq p predicates valid (null p))
412 (while p
413 (if (funcall (car p) entry)
414 (setq valid t)
415 (setq p nil valid nil))
416 (setq p (cdr p)))
417 (when valid
418 (nconc flist (list entry)))))
419 (if listified
420 (cadr flist)
421 (cdr flist))))
422
423(defsubst eshell-redisplay ()
424 "Allow Emacs to redisplay buffers."
425 ;; for some strange reason, Emacs 21 is prone to trigger an
426 ;; "args out of range" error in `sit-for', if this function
427 ;; runs while point is in the minibuffer and the users attempt
428 ;; to use completion. Don't ask me.
99abb67e
GM
429 (condition-case nil
430 (sit-for 0 0)
431 (error nil)))
26b4dc84
GM
432
433(defun eshell-read-passwd-file (file)
434 "Return an alist correlating gids to group names in FILE."
435 (let (names)
436 (when (file-readable-p file)
437 (with-temp-buffer
438 (insert-file-contents file)
439 (goto-char (point-min))
440 (while (not (eobp))
441 (let* ((fields
442 (split-string (buffer-substring
443 (point) (progn (end-of-line)
444 (point))) ":")))
b4bd214e 445 (if (and (and fields (nth 0 fields) (nth 2 fields))
6b0e3e4d
JW
446 (not (assq (string-to-number (nth 2 fields)) names)))
447 (setq names (cons (cons (string-to-number (nth 2 fields))
26b4dc84
GM
448 (nth 0 fields))
449 names))))
450 (forward-line))))
451 names))
452
453(defun eshell-read-passwd (file result-var timestamp-var)
454 "Read the contents of /etc/passwd for user names."
455 (if (or (not (symbol-value result-var))
456 (not (symbol-value timestamp-var))
73171bd4 457 (time-less-p
26b4dc84
GM
458 (symbol-value timestamp-var)
459 (nth 5 (file-attributes file))))
460 (progn
461 (set result-var (eshell-read-passwd-file file))
462 (set timestamp-var (current-time))))
463 (symbol-value result-var))
464
465(defun eshell-read-group-names ()
466 "Read the contents of /etc/group for group names."
467 (if eshell-group-file
468 (eshell-read-passwd eshell-group-file 'eshell-group-names
469 'eshell-group-timestamp)))
470
471(defsubst eshell-group-id (name)
472 "Return the user id for user NAME."
473 (car (rassoc name (eshell-read-group-names))))
474
475(defsubst eshell-group-name (gid)
476 "Return the group name for the given GID."
477 (cdr (assoc gid (eshell-read-group-names))))
478
479(defun eshell-read-user-names ()
480 "Read the contents of /etc/passwd for user names."
481 (if eshell-passwd-file
482 (eshell-read-passwd eshell-passwd-file 'eshell-user-names
483 'eshell-user-timestamp)))
484
485(defsubst eshell-user-id (name)
486 "Return the user id for user NAME."
487 (car (rassoc name (eshell-read-user-names))))
488
489(defalias 'eshell-user-name 'user-login-name)
490
491(defun eshell-read-hosts-file (filename)
492 "Read in the hosts from the /etc/hosts file."
493 (let (hosts)
494 (with-temp-buffer
495 (insert-file-contents eshell-hosts-file)
496 (goto-char (point-min))
497 (while (re-search-forward
498 "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
499 (if (match-string 1)
500 (add-to-list 'hosts (match-string 1)))
501 (if (match-string 2)
502 (add-to-list 'hosts (match-string 2)))
503 (if (match-string 4)
504 (add-to-list 'hosts (match-string 4)))))
505 (sort hosts 'string-lessp)))
506
507(defun eshell-read-hosts (file result-var timestamp-var)
508 "Read the contents of /etc/passwd for user names."
509 (if (or (not (symbol-value result-var))
510 (not (symbol-value timestamp-var))
73171bd4 511 (time-less-p
26b4dc84
GM
512 (symbol-value timestamp-var)
513 (nth 5 (file-attributes file))))
514 (progn
515 (set result-var (eshell-read-hosts-file file))
516 (set timestamp-var (current-time))))
517 (symbol-value result-var))
518
519(defun eshell-read-host-names ()
520 "Read the contents of /etc/hosts for host names."
521 (if eshell-hosts-file
522 (eshell-read-hosts eshell-hosts-file 'eshell-host-names
523 'eshell-host-timestamp)))
524
de3490e1
GM
525(and (featurep 'xemacs)
526 (not (fboundp 'subst-char-in-string))
527 (defun subst-char-in-string (fromchar tochar string &optional inplace)
528 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
26b4dc84 529Unless optional argument INPLACE is non-nil, return a new string."
de3490e1
GM
530 (let ((i (length string))
531 (newstr (if inplace string (copy-sequence string))))
532 (while (> i 0)
533 (setq i (1- i))
534 (if (eq (aref newstr i) fromchar)
535 (aset newstr i tochar)))
536 newstr)))
26b4dc84
GM
537
538(defsubst eshell-copy-environment ()
539 "Return an unrelated copy of `process-environment'."
540 (mapcar 'concat process-environment))
541
542(defun eshell-subgroups (groupsym)
543 "Return all of the subgroups of GROUPSYM."
544 (let ((subgroups (get groupsym 'custom-group))
545 (subg (list t)))
546 (while subgroups
547 (if (eq (cadr (car subgroups)) 'custom-group)
548 (nconc subg (list (caar subgroups))))
549 (setq subgroups (cdr subgroups)))
550 (cdr subg)))
551
552(defmacro eshell-with-file-modes (modes &rest forms)
553 "Evaluate, with file-modes set to MODES, the given FORMS."
554 `(let ((modes (default-file-modes)))
555 (set-default-file-modes ,modes)
556 (unwind-protect
557 (progn ,@forms)
558 (set-default-file-modes modes))))
559
560(defmacro eshell-with-private-file-modes (&rest forms)
561 "Evaluate FORMS with private file modes set."
562 `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
563
564(defsubst eshell-make-private-directory (dir &optional parents)
565 "Make DIR with file-modes set to `eshell-private-directory-modes'."
566 (eshell-with-file-modes eshell-private-directory-modes
567 (make-directory dir parents)))
568
569(defsubst eshell-substring (string sublen)
570 "Return the beginning of STRING, up to SUBLEN bytes."
571 (if string
572 (if (> (length string) sublen)
573 (substring string 0 sublen)
574 string)))
575
de3490e1
GM
576(and (featurep 'xemacs)
577 (not (fboundp 'directory-files-and-attributes))
578 (defun directory-files-and-attributes (directory &optional full match nosort id-format)
c4e5b888
JB
579 "Return a list of names of files and their attributes in DIRECTORY.
580There are three optional arguments:
581If FULL is non-nil, return absolute file names. Otherwise return names
582 that are relative to the specified directory.
583If MATCH is non-nil, mention only file names that match the regexp MATCH.
584If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
585 NOSORT is useful if you plan to sort the result yourself."
586 (let ((directory (expand-file-name directory)) ange-cache)
26b4dc84
GM
587 (mapcar
588 (function
589 (lambda (file)
de3490e1 590 (cons file (eshell-file-attributes (expand-file-name file directory)))))
c4e5b888 591 (directory-files directory full match nosort)))))
26b4dc84 592
1a32899d 593(defvar ange-cache)
8c6b1d83 594
8e9b2583 595(defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format)
26b4dc84 596 "Make sure to use the handler for `directory-file-and-attributes'."
61eef560
MA
597 (let* ((dir (expand-file-name dir)))
598 (if (string-equal (file-remote-p dir 'method) "ftp")
599 (let ((files (directory-files dir full match nosort)))
600 (mapcar
601 (lambda (file)
602 (cons file (eshell-file-attributes (expand-file-name file dir))))
603 files))
604 (directory-files-and-attributes dir full match nosort id-format))))
26b4dc84 605
8c6b1d83
JW
606(defun eshell-current-ange-uids ()
607 (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
608 (let* ((host (match-string 2 default-directory))
609 (user (match-string 1 default-directory))
610 (host-users (assoc host eshell-ange-ls-uids)))
611 (when host-users
612 (setq host-users (cdr host-users))
613 (cdr (assoc user host-users))))))
614
615;; Add an autoload for parse-time-string
616(if (and (not (fboundp 'parse-time-string))
617 (locate-library "parse-time"))
618 (autoload 'parse-time-string "parse-time"))
619
57a24508 620(eval-when-compile
61eef560
MA
621 (require 'ange-ftp nil t)
622 (require 'tramp nil t))
57a24508 623
8c6b1d83 624(defun eshell-parse-ange-ls (dir)
61eef560
MA
625 (let ((ange-ftp-name-format
626 (list (nth 0 tramp-file-name-structure)
627 (nth 3 tramp-file-name-structure)
628 (nth 2 tramp-file-name-structure)
629 (nth 4 tramp-file-name-structure)))
630 ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
631 ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
632 ;; there could be incorrect values from previous calls in case the
633 ;; "ftp" method is used in the Tramp file name. So we unset
634 ;; those values.
635 (ange-ftp-ftp-name-arg "")
636 (ange-ftp-ftp-name-res nil)
637 entry)
8c6b1d83
JW
638 (with-temp-buffer
639 (insert (ange-ftp-ls dir "-la" nil))
640 (goto-char (point-min))
641 (if (looking-at "^total [0-9]+$")
642 (forward-line 1))
643 ;; Some systems put in a blank line here.
644 (if (eolp) (forward-line 1))
645 (while (looking-at
646 `,(concat "\\([dlscb-][rwxst-]+\\)"
647 "\\s-*" "\\([0-9]+\\)" "\\s-+"
648 "\\(\\S-+\\)" "\\s-+"
649 "\\(\\S-+\\)" "\\s-+"
650 "\\([0-9]+\\)" "\\s-+" "\\(.*\\)"))
651 (let* ((perms (match-string 1))
652 (links (string-to-number (match-string 2)))
653 (user (match-string 3))
654 (group (match-string 4))
655 (size (string-to-number (match-string 5)))
a8b5bb5f 656 (name (ange-ftp-parse-filename))
8c6b1d83
JW
657 (mtime
658 (if (fboundp 'parse-time-string)
659 (let ((moment (parse-time-string
660 (match-string 6))))
661 (if (nth 0 moment)
662 (setcar (nthcdr 5 moment)
663 (nth 5 (decode-time (current-time))))
664 (setcar (nthcdr 0 moment) 0)
665 (setcar (nthcdr 1 moment) 0)
666 (setcar (nthcdr 2 moment) 0))
667 (apply 'encode-time moment))
668 (ange-ftp-file-modtime (expand-file-name name dir))))
8c6b1d83
JW
669 symlink)
670 (if (string-match "\\(.+\\) -> \\(.+\\)" name)
671 (setq symlink (match-string 2 name)
672 name (match-string 1 name)))
673 (setq entry
674 (cons
675 (cons name
676 (list (if (eq (aref perms 0) ?d)
677 t
678 symlink)
679 links user group
680 nil mtime nil
681 size perms nil nil)) entry)))
682 (forward-line)))
683 entry))
684
a4cc44cf
CY
685(defun eshell-file-attributes (file &optional id-format)
686 "Return the attributes of FILE, playing tricks if it's over ange-ftp.
687The optional argument ID-FORMAT specifies the preferred uid and
688gid format. Valid values are 'string and 'integer, defaulting to
689'integer. See `file-attributes'."
8c6b1d83 690 (let* ((file (expand-file-name file))
8c6b1d83 691 entry)
605a20a9
MA
692 (if (string-equal (file-remote-p file 'method) "ftp")
693 (let ((base (file-name-nondirectory file))
694 (dir (file-name-directory file)))
61eef560 695 (if (string-equal "" base) (setq base "."))
605a20a9
MA
696 (if (boundp 'ange-cache)
697 (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
698 (unless entry
699 (setq entry (eshell-parse-ange-ls dir))
8c6b1d83 700 (if (boundp 'ange-cache)
605a20a9
MA
701 (setq ange-cache
702 (cons (cons dir entry)
703 ange-cache)))
704 (if entry
705 (let ((fentry (assoc base (cdr entry))))
706 (if fentry
707 (setq entry (cdr fentry))
61eef560
MA
708 (setq entry nil)))))
709 entry)
a4cc44cf 710 (file-attributes file id-format))))
8c6b1d83 711
efbddb8e 712(defalias 'eshell-copy-tree 'copy-tree)
26b4dc84 713
b4bd214e
JW
714(defsubst eshell-processp (proc)
715 "If the `processp' function does not exist, PROC is not a process."
716 (and (fboundp 'processp) (processp proc)))
717
26b4dc84
GM
718; (defun eshell-copy-file
719; (file newname &optional ok-if-already-exists keep-date)
720; "Copy FILE to NEWNAME. See docs for `copy-file'."
721; (let (copied)
722; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
723; (let ((front (match-string 1 file))
724; (back (match-string 2 file))
725; buffer)
726; (if (and front (string-match eshell-tar-regexp front)
727; (setq buffer (find-file-noselect front)))
728; (with-current-buffer buffer
729; (goto-char (point-min))
730; (if (re-search-forward (concat " " (regexp-quote back)
731; "$") nil t)
732; (progn
733; (tar-copy (if (file-directory-p newname)
734; (expand-file-name
735; (file-name-nondirectory back) newname)
736; newname))
737; (setq copied t))
738; (error "%s not found in tar file %s" back front))))))
739; (unless copied
740; (copy-file file newname ok-if-already-exists keep-date))))
741
742; (defun eshell-file-attributes (filename)
743; "Return a list of attributes of file FILENAME.
744; See the documentation for `file-attributes'."
745; (let (result)
746; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
747; (let ((front (match-string 1 filename))
748; (back (match-string 2 filename))
749; buffer)
750; (when (and front (string-match eshell-tar-regexp front)
751; (setq buffer (find-file-noselect front)))
752; (with-current-buffer buffer
753; (goto-char (point-min))
754; (when (re-search-forward (concat " " (regexp-quote back)
755; "\\s-*$") nil t)
756; (let* ((descrip (tar-current-descriptor))
757; (tokens (tar-desc-tokens descrip)))
758; (setq result
759; (list
760; (cond
761; ((eq (tar-header-link-type tokens) 5)
762; t)
763; ((eq (tar-header-link-type tokens) t)
764; (tar-header-link-name tokens)))
765; 1
766; (tar-header-uid tokens)
767; (tar-header-gid tokens)
768; (tar-header-date tokens)
769; (tar-header-date tokens)
770; (tar-header-date tokens)
771; (tar-header-size tokens)
772; (concat
773; (cond
774; ((eq (tar-header-link-type tokens) 5) "d")
775; ((eq (tar-header-link-type tokens) t) "l")
776; (t "-"))
777; (tar-grind-file-mode (tar-header-mode tokens)
778; (make-string 9 ? ) 0))
779; nil nil nil))))))))
780; (or result
781; (file-attributes filename))))
782
99abb67e 783(provide 'esh-util)
26b4dc84
GM
784
785;;; esh-util.el ends here