code.delx.au - gnu-emacs/blob - lisp/eshell/esh-util.el

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