Merge from emacs-23; up to 2010-06-03T22:16:02Z!dann@ics.uci.edu
[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)
b2f603cc
GM
141 "If `eshell-handle-errors' is non-nil, this is `condition-case'.
142Otherwise, evaluates FORM with no error handling."
26b4dc84
GM
143 (if eshell-handle-errors
144 `(condition-case ,tag
145 ,form
146 ,@handlers)
147 form))
148
149(put 'eshell-condition-case 'lisp-indent-function 2)
150
26b4dc84
GM
151(defun eshell-find-delimiter
152 (open close &optional bound reverse-p backslash-p)
153 "From point, find the CLOSE delimiter corresponding to OPEN.
154The matching is bounded by BOUND.
155If REVERSE-P is non-nil, process the region backwards.
156If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character,
157then quoting is done by a backslash, rather than a doubled delimiter."
158 (save-excursion
159 (let ((depth 1)
160 (bound (or bound (point-max))))
161 (if (if reverse-p
162 (eq (char-before) close)
163 (eq (char-after) open))
164 (forward-char (if reverse-p -1 1)))
165 (while (and (> depth 0)
166 (funcall (if reverse-p '> '<) (point) bound))
167 (let ((c (if reverse-p (char-before) (char-after))) nc)
168 (cond ((and (not reverse-p)
169 (or (not (eq open close))
170 backslash-p)
171 (eq c ?\\)
172 (setq nc (char-after (1+ (point))))
173 (or (eq nc open) (eq nc close)))
174 (forward-char 1))
175 ((and reverse-p
176 (or (not (eq open close))
177 backslash-p)
178 (or (eq c open) (eq c close))
179 (eq (char-before (1- (point)))
180 ?\\))
181 (forward-char -1))
182 ((eq open close)
183 (if (eq c open)
184 (if (and (not backslash-p)
185 (eq (if reverse-p
186 (char-before (1- (point)))
187 (char-after (1+ (point)))) open))
188 (forward-char (if reverse-p -1 1))
189 (setq depth (1- depth)))))
190 ((= c open)
191 (setq depth (+ depth (if reverse-p -1 1))))
192 ((= c close)
193 (setq depth (+ depth (if reverse-p 1 -1))))))
194 (forward-char (if reverse-p -1 1)))
195 (if (= depth 0)
196 (if reverse-p (point) (1- (point)))))))
197
198(defun eshell-convert (string)
199 "Convert STRING into a more native looking Lisp object."
200 (if (not (stringp string))
201 string
202 (let ((len (length string)))
203 (if (= len 0)
204 string
205 (if (eq (aref string (1- len)) ?\n)
206 (setq string (substring string 0 (1- len))))
207 (if (string-match "\n" string)
208 (split-string string "\n")
209 (if (and eshell-convert-numeric-arguments
210 (string-match
211 (concat "\\`\\s-*" eshell-number-regexp
212 "\\s-*\\'") string))
213 (string-to-number string)
214 string))))))
215
216(defun eshell-sublist (l &optional n m)
217 "Return from LIST the N to M elements.
218If N or M is nil, it means the end of the list."
a9304a86 219 (let* ((a (copy-sequence l))
26b4dc84
GM
220 result)
221 (if (and m (consp (nthcdr m a)))
222 (setcdr (nthcdr m a) nil))
223 (if n
224 (setq a (nthcdr n a))
225 (setq n (1- (length a))
226 a (last a)))
227 a))
228
605a20a9
MA
229(defvar eshell-path-env (getenv "PATH")
230 "Content of $PATH.
231It might be different from \(getenv \"PATH\"\), when
232`default-directory' points to a remote host.")
233
234(defun eshell-parse-colon-path (path-env)
235 "Split string with `parse-colon-path'.
236Prepend remote identification of `default-directory', if any."
237 (let ((remote (file-remote-p default-directory)))
238 (if remote
239 (mapcar
240 (lambda (x) (concat remote x))
241 (parse-colon-path path-env))
242 (parse-colon-path path-env))))
243
26b4dc84
GM
244(defun eshell-split-path (path)
245 "Split a path into multiple subparts."
246 (let ((len (length path))
247 (i 0) (li 0)
248 parts)
249 (if (and (eshell-under-windows-p)
250 (> len 2)
6b0e3e4d
JW
251 (eq (aref path 0) ?/)
252 (eq (aref path 1) ?/))
26b4dc84
GM
253 (setq i 2))
254 (while (< i len)
6b0e3e4d 255 (if (and (eq (aref path i) ?/)
26b4dc84 256 (not (get-text-property i 'escaped path)))
6b0e3e4d 257 (setq parts (cons (if (= li i) "/"
26b4dc84
GM
258 (substring path li (1+ i))) parts)
259 li (1+ i)))
260 (setq i (1+ i)))
261 (if (< li i)
262 (setq parts (cons (substring path li i) parts)))
263 (if (and (eshell-under-windows-p)
264 (string-match "\\`[A-Za-z]:\\'" (car (last parts))))
6b0e3e4d 265 (setcar (last parts) (concat (car (last parts)) "/")))
26b4dc84
GM
266 (nreverse parts)))
267
268(defun eshell-to-flat-string (value)
269 "Make value a string. If separated by newlines change them to spaces."
270 (let ((text (eshell-stringify value)))
271 (if (string-match "\n+\\'" text)
272 (setq text (replace-match "" t t text)))
273 (while (string-match "\n+" text)
274 (setq text (replace-match " " t t text)))
275 text))
276
277(defmacro eshell-for (for-var for-list &rest forms)
278 "Iterate through a list"
279 `(let ((list-iter ,for-list))
280 (while list-iter
281 (let ((,for-var (car list-iter)))
282 ,@forms)
283 (setq list-iter (cdr list-iter)))))
284
285(put 'eshell-for 'lisp-indent-function 2)
286
a9eeff78
GM
287(make-obsolete 'eshell-for 'dolist "24.1")
288
ca7aae91 289(defun eshell-flatten-list (args)
26b4dc84
GM
290 "Flatten any lists within ARGS, so that there are no sublists."
291 (let ((new-list (list t)))
a9eeff78 292 (dolist (a args)
3bab4a46 293 (if (and (listp a)
26b4dc84
GM
294 (listp (cdr a)))
295 (nconc new-list (eshell-flatten-list a))
296 (nconc new-list (list a))))
297 (cdr new-list)))
298
299(defun eshell-uniqify-list (l)
300 "Remove occurring multiples in L. You probably want to sort first."
301 (let ((m l))
302 (while m
303 (while (and (cdr m)
304 (string= (car m)
305 (cadr m)))
306 (setcdr m (cddr m)))
307 (setq m (cdr m))))
308 l)
309
310(defun eshell-stringify (object)
311 "Convert OBJECT into a string value."
312 (cond
313 ((stringp object) object)
314 ((and (listp object)
315 (not (eq object nil)))
316 (let ((string (pp-to-string object)))
317 (substring string 0 (1- (length string)))))
318 ((numberp object)
319 (number-to-string object))
320 (t
dace60cf
JW
321 (unless (and (eq object t)
322 (not eshell-stringify-t))
323 (pp-to-string object)))))
26b4dc84
GM
324
325(defsubst eshell-stringify-list (args)
326 "Convert each element of ARGS into a string value."
327 (mapcar 'eshell-stringify args))
328
329(defsubst eshell-flatten-and-stringify (&rest args)
330 "Flatten and stringify all of the ARGS into a single string."
331 (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
332
26b4dc84
GM
333(defsubst eshell-directory-files (regexp &optional directory)
334 "Return a list of files in the given DIRECTORY matching REGEXP."
335 (directory-files (or directory default-directory)
336 directory regexp))
337
338(defun eshell-regexp-arg (prompt)
339 "Return list of regexp and prefix arg using PROMPT."
340 (let* (;; Don't clobber this.
341 (last-command last-command)
342 (regexp (read-from-minibuffer prompt nil nil nil
343 'minibuffer-history-search-history)))
344 (list (if (string-equal regexp "")
345 (setcar minibuffer-history-search-history
346 (nth 1 minibuffer-history-search-history))
347 regexp)
348 (prefix-numeric-value current-prefix-arg))))
349
350(defun eshell-printable-size (filesize &optional human-readable
351 block-size use-colors)
352 "Return a printable FILESIZE."
353 (let ((size (float (or filesize 0))))
354 (if human-readable
355 (if (< size human-readable)
356 (if (= (round size) 0)
357 "0"
358 (if block-size
359 "1.0k"
360 (format "%.0f" size)))
361 (setq size (/ size human-readable))
362 (if (< size human-readable)
363 (if (<= size 9.94)
364 (format "%.1fk" size)
365 (format "%.0fk" size))
366 (setq size (/ size human-readable))
367 (if (< size human-readable)
368 (let ((str (if (<= size 9.94)
369 (format "%.1fM" size)
370 (format "%.0fM" size))))
371 (if use-colors
372 (put-text-property 0 (length str)
373 'face 'bold str))
374 str)
375 (setq size (/ size human-readable))
376 (if (< size human-readable)
377 (let ((str (if (<= size 9.94)
378 (format "%.1fG" size)
379 (format "%.0fG" size))))
380 (if use-colors
381 (put-text-property 0 (length str)
382 'face 'bold-italic str))
383 str)))))
384 (if block-size
385 (setq size (/ size block-size)))
386 (format "%.0f" size))))
387
388(defun eshell-winnow-list (entries exclude &optional predicates)
389 "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
390The original list is not affected. If the result is only one element
391long, it will be returned itself, rather than returning a one-element
392list."
393 (let ((flist (list t))
394 valid p listified)
395 (unless (listp entries)
396 (setq entries (list entries)
397 listified t))
a9eeff78 398 (dolist (entry entries)
26b4dc84
GM
399 (unless (and exclude (string-match exclude entry))
400 (setq p predicates valid (null p))
401 (while p
402 (if (funcall (car p) entry)
403 (setq valid t)
404 (setq p nil valid nil))
405 (setq p (cdr p)))
406 (when valid
407 (nconc flist (list entry)))))
408 (if listified
409 (cadr flist)
410 (cdr flist))))
411
412(defsubst eshell-redisplay ()
413 "Allow Emacs to redisplay buffers."
414 ;; for some strange reason, Emacs 21 is prone to trigger an
415 ;; "args out of range" error in `sit-for', if this function
416 ;; runs while point is in the minibuffer and the users attempt
417 ;; to use completion. Don't ask me.
99abb67e
GM
418 (condition-case nil
419 (sit-for 0 0)
420 (error nil)))
26b4dc84
GM
421
422(defun eshell-read-passwd-file (file)
423 "Return an alist correlating gids to group names in FILE."
424 (let (names)
425 (when (file-readable-p file)
426 (with-temp-buffer
427 (insert-file-contents file)
428 (goto-char (point-min))
429 (while (not (eobp))
430 (let* ((fields
431 (split-string (buffer-substring
432 (point) (progn (end-of-line)
433 (point))) ":")))
b4bd214e 434 (if (and (and fields (nth 0 fields) (nth 2 fields))
6b0e3e4d
JW
435 (not (assq (string-to-number (nth 2 fields)) names)))
436 (setq names (cons (cons (string-to-number (nth 2 fields))
26b4dc84
GM
437 (nth 0 fields))
438 names))))
439 (forward-line))))
440 names))
441
442(defun eshell-read-passwd (file result-var timestamp-var)
443 "Read the contents of /etc/passwd for user names."
444 (if (or (not (symbol-value result-var))
445 (not (symbol-value timestamp-var))
73171bd4 446 (time-less-p
26b4dc84
GM
447 (symbol-value timestamp-var)
448 (nth 5 (file-attributes file))))
449 (progn
450 (set result-var (eshell-read-passwd-file file))
451 (set timestamp-var (current-time))))
452 (symbol-value result-var))
453
454(defun eshell-read-group-names ()
455 "Read the contents of /etc/group for group names."
456 (if eshell-group-file
457 (eshell-read-passwd eshell-group-file 'eshell-group-names
458 'eshell-group-timestamp)))
459
460(defsubst eshell-group-id (name)
461 "Return the user id for user NAME."
462 (car (rassoc name (eshell-read-group-names))))
463
464(defsubst eshell-group-name (gid)
465 "Return the group name for the given GID."
466 (cdr (assoc gid (eshell-read-group-names))))
467
468(defun eshell-read-user-names ()
469 "Read the contents of /etc/passwd for user names."
470 (if eshell-passwd-file
471 (eshell-read-passwd eshell-passwd-file 'eshell-user-names
472 'eshell-user-timestamp)))
473
474(defsubst eshell-user-id (name)
475 "Return the user id for user NAME."
476 (car (rassoc name (eshell-read-user-names))))
477
478(defalias 'eshell-user-name 'user-login-name)
479
480(defun eshell-read-hosts-file (filename)
481 "Read in the hosts from the /etc/hosts file."
482 (let (hosts)
483 (with-temp-buffer
484 (insert-file-contents eshell-hosts-file)
485 (goto-char (point-min))
486 (while (re-search-forward
487 "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
488 (if (match-string 1)
489 (add-to-list 'hosts (match-string 1)))
490 (if (match-string 2)
491 (add-to-list 'hosts (match-string 2)))
492 (if (match-string 4)
493 (add-to-list 'hosts (match-string 4)))))
494 (sort hosts 'string-lessp)))
495
496(defun eshell-read-hosts (file result-var timestamp-var)
497 "Read the contents of /etc/passwd for user names."
498 (if (or (not (symbol-value result-var))
499 (not (symbol-value timestamp-var))
73171bd4 500 (time-less-p
26b4dc84
GM
501 (symbol-value timestamp-var)
502 (nth 5 (file-attributes file))))
503 (progn
504 (set result-var (eshell-read-hosts-file file))
505 (set timestamp-var (current-time))))
506 (symbol-value result-var))
507
508(defun eshell-read-host-names ()
509 "Read the contents of /etc/hosts for host names."
510 (if eshell-hosts-file
511 (eshell-read-hosts eshell-hosts-file 'eshell-host-names
512 'eshell-host-timestamp)))
513
de3490e1
GM
514(and (featurep 'xemacs)
515 (not (fboundp 'subst-char-in-string))
516 (defun subst-char-in-string (fromchar tochar string &optional inplace)
517 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
26b4dc84 518Unless optional argument INPLACE is non-nil, return a new string."
de3490e1
GM
519 (let ((i (length string))
520 (newstr (if inplace string (copy-sequence string))))
521 (while (> i 0)
522 (setq i (1- i))
523 (if (eq (aref newstr i) fromchar)
524 (aset newstr i tochar)))
525 newstr)))
26b4dc84
GM
526
527(defsubst eshell-copy-environment ()
528 "Return an unrelated copy of `process-environment'."
529 (mapcar 'concat process-environment))
530
531(defun eshell-subgroups (groupsym)
532 "Return all of the subgroups of GROUPSYM."
533 (let ((subgroups (get groupsym 'custom-group))
534 (subg (list t)))
535 (while subgroups
536 (if (eq (cadr (car subgroups)) 'custom-group)
537 (nconc subg (list (caar subgroups))))
538 (setq subgroups (cdr subgroups)))
539 (cdr subg)))
540
541(defmacro eshell-with-file-modes (modes &rest forms)
542 "Evaluate, with file-modes set to MODES, the given FORMS."
543 `(let ((modes (default-file-modes)))
544 (set-default-file-modes ,modes)
545 (unwind-protect
546 (progn ,@forms)
547 (set-default-file-modes modes))))
548
549(defmacro eshell-with-private-file-modes (&rest forms)
550 "Evaluate FORMS with private file modes set."
551 `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
552
553(defsubst eshell-make-private-directory (dir &optional parents)
554 "Make DIR with file-modes set to `eshell-private-directory-modes'."
555 (eshell-with-file-modes eshell-private-directory-modes
556 (make-directory dir parents)))
557
558(defsubst eshell-substring (string sublen)
559 "Return the beginning of STRING, up to SUBLEN bytes."
560 (if string
561 (if (> (length string) sublen)
562 (substring string 0 sublen)
563 string)))
564
de3490e1
GM
565(and (featurep 'xemacs)
566 (not (fboundp 'directory-files-and-attributes))
567 (defun directory-files-and-attributes (directory &optional full match nosort id-format)
c4e5b888
JB
568 "Return a list of names of files and their attributes in DIRECTORY.
569There are three optional arguments:
570If FULL is non-nil, return absolute file names. Otherwise return names
571 that are relative to the specified directory.
572If MATCH is non-nil, mention only file names that match the regexp MATCH.
573If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
574 NOSORT is useful if you plan to sort the result yourself."
575 (let ((directory (expand-file-name directory)) ange-cache)
26b4dc84
GM
576 (mapcar
577 (function
578 (lambda (file)
de3490e1 579 (cons file (eshell-file-attributes (expand-file-name file directory)))))
c4e5b888 580 (directory-files directory full match nosort)))))
26b4dc84 581
1a32899d 582(defvar ange-cache)
8c6b1d83 583
8e9b2583 584(defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format)
26b4dc84 585 "Make sure to use the handler for `directory-file-and-attributes'."
61eef560
MA
586 (let* ((dir (expand-file-name dir)))
587 (if (string-equal (file-remote-p dir 'method) "ftp")
588 (let ((files (directory-files dir full match nosort)))
589 (mapcar
590 (lambda (file)
591 (cons file (eshell-file-attributes (expand-file-name file dir))))
592 files))
593 (directory-files-and-attributes dir full match nosort id-format))))
26b4dc84 594
8c6b1d83
JW
595(defun eshell-current-ange-uids ()
596 (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
597 (let* ((host (match-string 2 default-directory))
598 (user (match-string 1 default-directory))
599 (host-users (assoc host eshell-ange-ls-uids)))
600 (when host-users
601 (setq host-users (cdr host-users))
602 (cdr (assoc user host-users))))))
603
604;; Add an autoload for parse-time-string
605(if (and (not (fboundp 'parse-time-string))
606 (locate-library "parse-time"))
607 (autoload 'parse-time-string "parse-time"))
608
57a24508 609(eval-when-compile
61eef560
MA
610 (require 'ange-ftp nil t)
611 (require 'tramp nil t))
57a24508 612
8c6b1d83 613(defun eshell-parse-ange-ls (dir)
61eef560
MA
614 (let ((ange-ftp-name-format
615 (list (nth 0 tramp-file-name-structure)
616 (nth 3 tramp-file-name-structure)
617 (nth 2 tramp-file-name-structure)
618 (nth 4 tramp-file-name-structure)))
619 ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
620 ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
621 ;; there could be incorrect values from previous calls in case the
622 ;; "ftp" method is used in the Tramp file name. So we unset
623 ;; those values.
624 (ange-ftp-ftp-name-arg "")
625 (ange-ftp-ftp-name-res nil)
626 entry)
8c6b1d83
JW
627 (with-temp-buffer
628 (insert (ange-ftp-ls dir "-la" nil))
629 (goto-char (point-min))
630 (if (looking-at "^total [0-9]+$")
631 (forward-line 1))
632 ;; Some systems put in a blank line here.
633 (if (eolp) (forward-line 1))
634 (while (looking-at
635 `,(concat "\\([dlscb-][rwxst-]+\\)"
636 "\\s-*" "\\([0-9]+\\)" "\\s-+"
637 "\\(\\S-+\\)" "\\s-+"
638 "\\(\\S-+\\)" "\\s-+"
639 "\\([0-9]+\\)" "\\s-+" "\\(.*\\)"))
640 (let* ((perms (match-string 1))
641 (links (string-to-number (match-string 2)))
642 (user (match-string 3))
643 (group (match-string 4))
644 (size (string-to-number (match-string 5)))
a8b5bb5f 645 (name (ange-ftp-parse-filename))
8c6b1d83
JW
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))))
8c6b1d83
JW
658 symlink)
659 (if (string-match "\\(.+\\) -> \\(.+\\)" name)
660 (setq symlink (match-string 2 name)
661 name (match-string 1 name)))
662 (setq entry
663 (cons
664 (cons name
665 (list (if (eq (aref perms 0) ?d)
666 t
667 symlink)
668 links user group
669 nil mtime nil
670 size perms nil nil)) entry)))
671 (forward-line)))
672 entry))
673
a4cc44cf
CY
674(defun eshell-file-attributes (file &optional id-format)
675 "Return the attributes of FILE, playing tricks if it's over ange-ftp.
676The optional argument ID-FORMAT specifies the preferred uid and
677gid format. Valid values are 'string and 'integer, defaulting to
678'integer. See `file-attributes'."
8c6b1d83 679 (let* ((file (expand-file-name file))
8c6b1d83 680 entry)
605a20a9
MA
681 (if (string-equal (file-remote-p file 'method) "ftp")
682 (let ((base (file-name-nondirectory file))
683 (dir (file-name-directory file)))
61eef560 684 (if (string-equal "" base) (setq base "."))
605a20a9
MA
685 (if (boundp 'ange-cache)
686 (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
687 (unless entry
688 (setq entry (eshell-parse-ange-ls dir))
8c6b1d83 689 (if (boundp 'ange-cache)
605a20a9
MA
690 (setq ange-cache
691 (cons (cons dir entry)
692 ange-cache)))
693 (if entry
694 (let ((fentry (assoc base (cdr entry))))
695 (if fentry
696 (setq entry (cdr fentry))
61eef560
MA
697 (setq entry nil)))))
698 entry)
a4cc44cf 699 (file-attributes file id-format))))
8c6b1d83 700
efbddb8e 701(defalias 'eshell-copy-tree 'copy-tree)
26b4dc84 702
b4bd214e
JW
703(defsubst eshell-processp (proc)
704 "If the `processp' function does not exist, PROC is not a process."
705 (and (fboundp 'processp) (processp proc)))
706
26b4dc84
GM
707; (defun eshell-copy-file
708; (file newname &optional ok-if-already-exists keep-date)
709; "Copy FILE to NEWNAME. See docs for `copy-file'."
710; (let (copied)
711; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
712; (let ((front (match-string 1 file))
713; (back (match-string 2 file))
714; buffer)
715; (if (and front (string-match eshell-tar-regexp front)
716; (setq buffer (find-file-noselect front)))
717; (with-current-buffer buffer
718; (goto-char (point-min))
719; (if (re-search-forward (concat " " (regexp-quote back)
720; "$") nil t)
721; (progn
722; (tar-copy (if (file-directory-p newname)
723; (expand-file-name
724; (file-name-nondirectory back) newname)
725; newname))
726; (setq copied t))
727; (error "%s not found in tar file %s" back front))))))
728; (unless copied
729; (copy-file file newname ok-if-already-exists keep-date))))
730
731; (defun eshell-file-attributes (filename)
732; "Return a list of attributes of file FILENAME.
733; See the documentation for `file-attributes'."
734; (let (result)
735; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
736; (let ((front (match-string 1 filename))
737; (back (match-string 2 filename))
738; buffer)
739; (when (and front (string-match eshell-tar-regexp front)
740; (setq buffer (find-file-noselect front)))
741; (with-current-buffer buffer
742; (goto-char (point-min))
743; (when (re-search-forward (concat " " (regexp-quote back)
744; "\\s-*$") nil t)
745; (let* ((descrip (tar-current-descriptor))
746; (tokens (tar-desc-tokens descrip)))
747; (setq result
748; (list
749; (cond
750; ((eq (tar-header-link-type tokens) 5)
751; t)
752; ((eq (tar-header-link-type tokens) t)
753; (tar-header-link-name tokens)))
754; 1
755; (tar-header-uid tokens)
756; (tar-header-gid tokens)
757; (tar-header-date tokens)
758; (tar-header-date tokens)
759; (tar-header-date tokens)
760; (tar-header-size tokens)
761; (concat
762; (cond
763; ((eq (tar-header-link-type tokens) 5) "d")
764; ((eq (tar-header-link-type tokens) t) "l")
765; (t "-"))
766; (tar-grind-file-mode (tar-header-mode tokens)
767; (make-string 9 ? ) 0))
768; nil nil nil))))))))
769; (or result
770; (file-attributes filename))))
771
99abb67e 772(provide 'esh-util)
26b4dc84
GM
773
774;;; esh-util.el ends here