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