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