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  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 ;; the next two are from GNUS, and really should be made part of Emacs
 345 ;; some day
 346 (defsubst eshell-time-less-p (t1 t2)
 347   "Say whether time T1 is less than time T2."
 348   (or (< (car t1) (car t2))
 349       (and (= (car t1) (car t2))
 350            (< (nth 1 t1) (nth 1 t2)))))
 351
 352 (defsubst eshell-time-to-seconds (time)
 353   "Convert TIME to a floating point number."
 354   (+ (* (car time) 65536.0)
 355      (cadr time)
 356      (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
 357
 358 (defsubst eshell-directory-files (regexp &optional directory)
 359   "Return a list of files in the given DIRECTORY matching REGEXP."
 360   (directory-files (or directory default-directory)
 361                    directory regexp))
 362
 363 (defun eshell-regexp-arg (prompt)
 364   "Return list of regexp and prefix arg using PROMPT."
 365   (let* (;; Don't clobber this.
 366          (last-command last-command)
 367          (regexp (read-from-minibuffer prompt nil nil nil
 368                                        'minibuffer-history-search-history)))
 369     (list (if (string-equal regexp "")
 370               (setcar minibuffer-history-search-history
 371                       (nth 1 minibuffer-history-search-history))
 372             regexp)
 373           (prefix-numeric-value current-prefix-arg))))
 374
 375 (defun eshell-printable-size (filesize &optional human-readable
 376                                        block-size use-colors)
 377   "Return a printable FILESIZE."
 378   (let ((size (float (or filesize 0))))
 379     (if human-readable
 380         (if (< size human-readable)
 381             (if (= (round size) 0)
 382                 "0"
 383               (if block-size
 384                   "1.0k"
 385                 (format "%.0f" size)))
 386           (setq size (/ size human-readable))
 387           (if (< size human-readable)
 388               (if (<= size 9.94)
 389                   (format "%.1fk" size)
 390                 (format "%.0fk" size))
 391             (setq size (/ size human-readable))
 392             (if (< size human-readable)
 393                 (let ((str (if (<= size 9.94)
 394                                (format "%.1fM" size)
 395                              (format "%.0fM" size))))
 396                   (if use-colors
 397                       (put-text-property 0 (length str)
 398                                          'face 'bold str))
 399                   str)
 400               (setq size (/ size human-readable))
 401               (if (< size human-readable)
 402                   (let ((str (if (<= size 9.94)
 403                                  (format "%.1fG" size)
 404                                (format "%.0fG" size))))
 405                     (if use-colors
 406                         (put-text-property 0 (length str)
 407                                            'face 'bold-italic str))
 408                     str)))))
 409       (if block-size
 410           (setq size (/ size block-size)))
 411       (format "%.0f" size))))
 412
 413 (defun eshell-winnow-list (entries exclude &optional predicates)
 414   "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
 415 The original list is not affected.  If the result is only one element
 416 long, it will be returned itself, rather than returning a one-element
 417 list."
 418   (let ((flist (list t))
 419         valid p listified)
 420     (unless (listp entries)
 421       (setq entries (list entries)
 422             listified t))
 423     (eshell-for entry entries
 424       (unless (and exclude (string-match exclude entry))
 425         (setq p predicates valid (null p))
 426         (while p
 427           (if (funcall (car p) entry)
 428               (setq valid t)
 429             (setq p nil valid nil))
 430           (setq p (cdr p)))
 431         (when valid
 432           (nconc flist (list entry)))))
 433     (if listified
 434         (cadr flist)
 435       (cdr flist))))
 436
 437 (defsubst eshell-redisplay ()
 438   "Allow Emacs to redisplay buffers."
 439   ;; for some strange reason, Emacs 21 is prone to trigger an
 440   ;; "args out of range" error in `sit-for', if this function
 441   ;; runs while point is in the minibuffer and the users attempt
 442   ;; to use completion.  Don't ask me.
 443   (condition-case nil
 444       (sit-for 0 0)
 445     (error nil)))
 446
 447 (defun eshell-read-passwd-file (file)
 448   "Return an alist correlating gids to group names in FILE."
 449   (let (names)
 450     (when (file-readable-p file)
 451       (with-temp-buffer
 452         (insert-file-contents file)
 453         (goto-char (point-min))
 454         (while (not (eobp))
 455           (let* ((fields
 456                   (split-string (buffer-substring
 457                                  (point) (progn (end-of-line)
 458                                                 (point))) ":")))
 459             (if (and (and fields (nth 0 fields) (nth 2 fields))
 460                      (not (assq (string-to-number (nth 2 fields)) names)))
 461                 (setq names (cons (cons (string-to-number (nth 2 fields))
 462                                         (nth 0 fields))
 463                                   names))))
 464           (forward-line))))
 465     names))
 466
 467 (defun eshell-read-passwd (file result-var timestamp-var)
 468   "Read the contents of /etc/passwd for user names."
 469   (if (or (not (symbol-value result-var))
 470           (not (symbol-value timestamp-var))
 471           (eshell-time-less-p
 472            (symbol-value timestamp-var)
 473            (nth 5 (file-attributes file))))
 474       (progn
 475         (set result-var (eshell-read-passwd-file file))
 476         (set timestamp-var (current-time))))
 477   (symbol-value result-var))
 478
 479 (defun eshell-read-group-names ()
 480   "Read the contents of /etc/group for group names."
 481   (if eshell-group-file
 482       (eshell-read-passwd eshell-group-file 'eshell-group-names
 483                           'eshell-group-timestamp)))
 484
 485 (defsubst eshell-group-id (name)
 486   "Return the user id for user NAME."
 487   (car (rassoc name (eshell-read-group-names))))
 488
 489 (defsubst eshell-group-name (gid)
 490   "Return the group name for the given GID."
 491   (cdr (assoc gid (eshell-read-group-names))))
 492
 493 (defun eshell-read-user-names ()
 494   "Read the contents of /etc/passwd for user names."
 495   (if eshell-passwd-file
 496       (eshell-read-passwd eshell-passwd-file 'eshell-user-names
 497                           'eshell-user-timestamp)))
 498
 499 (defsubst eshell-user-id (name)
 500   "Return the user id for user NAME."
 501   (car (rassoc name (eshell-read-user-names))))
 502
 503 (defalias 'eshell-user-name 'user-login-name)
 504
 505 (defun eshell-read-hosts-file (filename)
 506   "Read in the hosts from the /etc/hosts file."
 507   (let (hosts)
 508     (with-temp-buffer
 509       (insert-file-contents eshell-hosts-file)
 510       (goto-char (point-min))
 511       (while (re-search-forward
 512               "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
 513         (if (match-string 1)
 514             (add-to-list 'hosts (match-string 1)))
 515         (if (match-string 2)
 516             (add-to-list 'hosts (match-string 2)))
 517         (if (match-string 4)
 518             (add-to-list 'hosts (match-string 4)))))
 519     (sort hosts 'string-lessp)))
 520
 521 (defun eshell-read-hosts (file result-var timestamp-var)
 522   "Read the contents of /etc/passwd for user names."
 523   (if (or (not (symbol-value result-var))
 524           (not (symbol-value timestamp-var))
 525           (eshell-time-less-p
 526            (symbol-value timestamp-var)
 527            (nth 5 (file-attributes file))))
 528       (progn
 529         (set result-var (eshell-read-hosts-file file))
 530         (set timestamp-var (current-time))))
 531   (symbol-value result-var))
 532
 533 (defun eshell-read-host-names ()
 534   "Read the contents of /etc/hosts for host names."
 535   (if eshell-hosts-file
 536       (eshell-read-hosts eshell-hosts-file 'eshell-host-names
 537                          'eshell-host-timestamp)))
 538
 539 (unless (fboundp 'line-end-position)
 540   (defsubst line-end-position (&optional N)
 541     (save-excursion (end-of-line N) (point))))
 542
 543 (unless (fboundp 'line-beginning-position)
 544   (defsubst line-beginning-position (&optional N)
 545     (save-excursion (beginning-of-line N) (point))))
 546
 547 (unless (fboundp 'subst-char-in-string)
 548   (defun subst-char-in-string (fromchar tochar string &optional inplace)
 549     "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
 550 Unless optional argument INPLACE is non-nil, return a new string."
 551     (let ((i (length string))
 552           (newstr (if inplace string (copy-sequence string))))
 553       (while (> i 0)
 554         (setq i (1- i))
 555         (if (eq (aref newstr i) fromchar)
 556             (aset newstr i tochar)))
 557       newstr)))
 558
 559 (defsubst eshell-copy-environment ()
 560   "Return an unrelated copy of `process-environment'."
 561   (mapcar 'concat process-environment))
 562
 563 (defun eshell-subgroups (groupsym)
 564   "Return all of the subgroups of GROUPSYM."
 565   (let ((subgroups (get groupsym 'custom-group))
 566         (subg (list t)))
 567     (while subgroups
 568       (if (eq (cadr (car subgroups)) 'custom-group)
 569           (nconc subg (list (caar subgroups))))
 570       (setq subgroups (cdr subgroups)))
 571     (cdr subg)))
 572
 573 (defmacro eshell-with-file-modes (modes &rest forms)
 574   "Evaluate, with file-modes set to MODES, the given FORMS."
 575   `(let ((modes (default-file-modes)))
 576      (set-default-file-modes ,modes)
 577      (unwind-protect
 578          (progn ,@forms)
 579        (set-default-file-modes modes))))
 580
 581 (defmacro eshell-with-private-file-modes (&rest forms)
 582   "Evaluate FORMS with private file modes set."
 583   `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
 584
 585 (defsubst eshell-make-private-directory (dir &optional parents)
 586   "Make DIR with file-modes set to `eshell-private-directory-modes'."
 587   (eshell-with-file-modes eshell-private-directory-modes
 588                           (make-directory dir parents)))
 589
 590 (defsubst eshell-substring (string sublen)
 591   "Return the beginning of STRING, up to SUBLEN bytes."
 592   (if string
 593       (if (> (length string) sublen)
 594           (substring string 0 sublen)
 595         string)))
 596
 597 (unless (fboundp 'directory-files-and-attributes)
 598   (defun directory-files-and-attributes (directory &optional full match nosort id-format)
 599     "Return a list of names of files and their attributes in DIRECTORY.
 600 There are three optional arguments:
 601 If FULL is non-nil, return absolute file names.  Otherwise return names
 602  that are relative to the specified directory.
 603 If MATCH is non-nil, mention only file names that match the regexp MATCH.
 604 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
 605  NOSORT is useful if you plan to sort the result yourself."
 606     (let ((directory (expand-file-name directory)) ange-cache)
 607       (mapcar
 608        (function
 609         (lambda (file)
 610          (cons file (eshell-file-attributes (expand-file-name file directory)))))
 611        (directory-files directory full match nosort)))))
 612
 613 (defvar ange-cache)
 614
 615 (defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format)
 616   "Make sure to use the handler for `directory-file-and-attributes'."
 617   (let* ((dir (expand-file-name dir)))
 618     (if (string-equal (file-remote-p dir 'method) "ftp")
 619         (let ((files (directory-files dir full match nosort)))
 620           (mapcar
 621            (lambda (file)
 622              (cons file (eshell-file-attributes (expand-file-name file dir))))
 623            files))
 624       (directory-files-and-attributes dir full match nosort id-format))))
 625
 626 (defun eshell-current-ange-uids ()
 627   (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
 628       (let* ((host (match-string 2 default-directory))
 629              (user (match-string 1 default-directory))
 630              (host-users (assoc host eshell-ange-ls-uids)))
 631         (when host-users
 632           (setq host-users (cdr host-users))
 633           (cdr (assoc user host-users))))))
 634
 635 ;; Add an autoload for parse-time-string
 636 (if (and (not (fboundp 'parse-time-string))
 637          (locate-library "parse-time"))
 638     (autoload 'parse-time-string "parse-time"))
 639
 640 (eval-when-compile
 641   (require 'ange-ftp nil t)
 642   (require 'tramp nil t))
 643
 644 (defun eshell-parse-ange-ls (dir)
 645   (let ((ange-ftp-name-format
 646          (list (nth 0 tramp-file-name-structure)
 647                (nth 3 tramp-file-name-structure)
 648                (nth 2 tramp-file-name-structure)
 649                (nth 4 tramp-file-name-structure)))
 650         ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
 651         ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
 652         ;; there could be incorrect values from previous calls in case the
 653         ;; "ftp" method is used in the Tramp file name. So we unset
 654         ;; those values.
 655         (ange-ftp-ftp-name-arg "")
 656         (ange-ftp-ftp-name-res nil)
 657         entry)
 658     (with-temp-buffer
 659       (insert (ange-ftp-ls dir "-la" nil))
 660       (goto-char (point-min))
 661       (if (looking-at "^total [0-9]+$")
 662           (forward-line 1))
 663       ;; Some systems put in a blank line here.
 664       (if (eolp) (forward-line 1))
 665       (while (looking-at
 666               `,(concat "\\([dlscb-][rwxst-]+\\)"
 667                         "\\s-*" "\\([0-9]+\\)" "\\s-+"
 668                         "\\(\\S-+\\)" "\\s-+"
 669                         "\\(\\S-+\\)" "\\s-+"
 670                         "\\([0-9]+\\)" "\\s-+" "\\(.*\\)"))
 671         (let* ((perms (match-string 1))
 672                (links (string-to-number (match-string 2)))
 673                (user (match-string 3))
 674                (group (match-string 4))
 675                (size (string-to-number (match-string 5)))
 676                (name (ange-ftp-parse-filename))
 677                (mtime
 678                 (if (fboundp 'parse-time-string)
 679                     (let ((moment (parse-time-string
 680                                    (match-string 6))))
 681                       (if (nth 0 moment)
 682                           (setcar (nthcdr 5 moment)
 683                                   (nth 5 (decode-time (current-time))))
 684                         (setcar (nthcdr 0 moment) 0)
 685                         (setcar (nthcdr 1 moment) 0)
 686                         (setcar (nthcdr 2 moment) 0))
 687                       (apply 'encode-time moment))
 688                   (ange-ftp-file-modtime (expand-file-name name dir))))
 689                symlink)
 690           (if (string-match "\\(.+\\) -> \\(.+\\)" name)
 691               (setq symlink (match-string 2 name)
 692                     name (match-string 1 name)))
 693           (setq entry
 694                 (cons
 695                  (cons name
 696                        (list (if (eq (aref perms 0) ?d)
 697                                  t
 698                                symlink)
 699                              links user group
 700                              nil mtime nil
 701                              size perms nil nil)) entry)))
 702         (forward-line)))
 703     entry))
 704
 705 (defun eshell-file-attributes (file &optional id-format)
 706   "Return the attributes of FILE, playing tricks if it's over ange-ftp.
 707 The optional argument ID-FORMAT specifies the preferred uid and
 708 gid format.  Valid values are 'string and 'integer, defaulting to
 709 'integer.  See `file-attributes'."
 710   (let* ((file (expand-file-name file))
 711          entry)
 712     (if (string-equal (file-remote-p file 'method) "ftp")
 713         (let ((base (file-name-nondirectory file))
 714               (dir (file-name-directory file)))
 715           (if (string-equal "" base) (setq base "."))
 716           (if (boundp 'ange-cache)
 717               (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
 718           (unless entry
 719             (setq entry (eshell-parse-ange-ls dir))
 720             (if (boundp 'ange-cache)
 721                 (setq ange-cache
 722                       (cons (cons dir entry)
 723                             ange-cache)))
 724             (if entry
 725                 (let ((fentry (assoc base (cdr entry))))
 726                   (if fentry
 727                       (setq entry (cdr fentry))
 728                     (setq entry nil)))))
 729           entry)
 730       (file-attributes file id-format))))
 731
 732 (defalias 'eshell-copy-tree 'copy-tree)
 733
 734 (defsubst eshell-processp (proc)
 735   "If the `processp' function does not exist, PROC is not a process."
 736   (and (fboundp 'processp) (processp proc)))
 737
 738 ; (defun eshell-copy-file
 739 ;   (file newname &optional ok-if-already-exists keep-date)
 740 ;   "Copy FILE to NEWNAME.  See docs for `copy-file'."
 741 ;   (let (copied)
 742 ;     (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
 743 ;       (let ((front (match-string 1 file))
 744 ;             (back (match-string 2 file))
 745 ;             buffer)
 746 ;         (if (and front (string-match eshell-tar-regexp front)
 747 ;                    (setq buffer (find-file-noselect front)))
 748 ;           (with-current-buffer buffer
 749 ;             (goto-char (point-min))
 750 ;             (if (re-search-forward (concat " " (regexp-quote back)
 751 ;                                            "$") nil t)
 752 ;                 (progn
 753 ;                   (tar-copy (if (file-directory-p newname)
 754 ;                                 (expand-file-name
 755 ;                                  (file-name-nondirectory back) newname)
 756 ;                               newname))
 757 ;                   (setq copied t))
 758 ;               (error "%s not found in tar file %s" back front))))))
 759 ;     (unless copied
 760 ;       (copy-file file newname ok-if-already-exists keep-date))))
 761
 762 ; (defun eshell-file-attributes (filename)
 763 ;   "Return a list of attributes of file FILENAME.
 764 ; See the documentation for `file-attributes'."
 765 ;   (let (result)
 766 ;     (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
 767 ;       (let ((front (match-string 1 filename))
 768 ;           (back (match-string 2 filename))
 769 ;           buffer)
 770 ;       (when (and front (string-match eshell-tar-regexp front)
 771 ;                  (setq buffer (find-file-noselect front)))
 772 ;         (with-current-buffer buffer
 773 ;           (goto-char (point-min))
 774 ;           (when (re-search-forward (concat " " (regexp-quote back)
 775 ;                                            "\\s-*$") nil t)
 776 ;             (let* ((descrip (tar-current-descriptor))
 777 ;                    (tokens (tar-desc-tokens descrip)))
 778 ;               (setq result
 779 ;                     (list
 780 ;                      (cond
 781 ;                       ((eq (tar-header-link-type tokens) 5)
 782 ;                        t)
 783 ;                       ((eq (tar-header-link-type tokens) t)
 784 ;                        (tar-header-link-name tokens)))
 785 ;                      1
 786 ;                      (tar-header-uid tokens)
 787 ;                      (tar-header-gid tokens)
 788 ;                      (tar-header-date tokens)
 789 ;                      (tar-header-date tokens)
 790 ;                      (tar-header-date tokens)
 791 ;                      (tar-header-size tokens)
 792 ;                      (concat
 793 ;                       (cond
 794 ;                        ((eq (tar-header-link-type tokens) 5) "d")
 795 ;                        ((eq (tar-header-link-type tokens) t) "l")
 796 ;                        (t "-"))
 797 ;                       (tar-grind-file-mode (tar-header-mode tokens)
 798 ;                                            (make-string 9 ? ) 0))
 799 ;                      nil nil nil))))))))
 800 ;     (or result
 801 ;       (file-attributes filename))))
 802
 803 (provide 'esh-util)
 804
 805 ;; arch-tag: 70159778-5c7a-480a-bae4-3ad332fca19d
 806 ;;; esh-util.el ends here