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