Add 2012 to FSF copyright years for Emacs files
[bpt/emacs.git] / lisp / eshell / esh-util.el
index 95a14db..f111fd9 100644 (file)
@@ -1,7 +1,6 @@
 ;;; esh-util.el --- general utilities
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012  Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw@gnu.org>
 
@@ -32,7 +31,7 @@
 ;;; User Variables:
 
 (defcustom eshell-stringify-t t
-  "*If non-nil, the string representation of t is 't'.
+  "If non-nil, the string representation of t is 't'.
 If nil, t will be represented only in the exit code of the function,
 and not printed as a string.  This causes Lisp functions to behave
 similarly to external commands, as far as successful result output."
@@ -40,48 +39,49 @@ similarly to external commands, as far as successful result output."
   :group 'eshell-util)
 
 (defcustom eshell-group-file "/etc/group"
-  "*If non-nil, the name of the group file on your system."
+  "If non-nil, the name of the group file on your system."
   :type '(choice (const :tag "No group file" nil) file)
   :group 'eshell-util)
 
 (defcustom eshell-passwd-file "/etc/passwd"
-  "*If non-nil, the name of the passwd file on your system."
+  "If non-nil, the name of the passwd file on your system."
   :type '(choice (const :tag "No passwd file" nil) file)
   :group 'eshell-util)
 
 (defcustom eshell-hosts-file "/etc/hosts"
-  "*The name of the /etc/hosts file."
+  "The name of the /etc/hosts file."
   :type '(choice (const :tag "No hosts file" nil) file)
   :group 'eshell-util)
 
 (defcustom eshell-handle-errors t
-  "*If non-nil, Eshell will handle errors itself.
+  "If non-nil, Eshell will handle errors itself.
 Setting this to nil is offered as an aid to debugging only."
   :type 'boolean
   :group 'eshell-util)
 
 (defcustom eshell-private-file-modes 384 ; umask 177
-  "*The file-modes value to use for creating \"private\" files."
+  "The file-modes value to use for creating \"private\" files."
   :type 'integer
   :group 'eshell-util)
 
 (defcustom eshell-private-directory-modes 448 ; umask 077
-  "*The file-modes value to use for creating \"private\" directories."
+  "The file-modes value to use for creating \"private\" directories."
   :type 'integer
   :group 'eshell-util)
 
 (defcustom eshell-tar-regexp
-  "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
-  "*Regular expression used to match tar file names."
+  "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
+  "Regular expression used to match tar file names."
+  :version "24.1"                      ; added xz
   :type 'regexp
   :group 'eshell-util)
 
 (defcustom eshell-convert-numeric-arguments t
-  "*If non-nil, converting arguments of numeric form to Lisp numbers.
+  "If non-nil, converting arguments of numeric form to Lisp numbers.
 Numeric form is tested using the regular expression
 `eshell-number-regexp'.
 
-NOTE: If you find that numeric conversions are intefering with the
+NOTE: If you find that numeric conversions are interfering with the
 specification of filenames (for example, in calling `find-file', or
 some other Lisp function that deals with files, not numbers), add the
 following in your .emacs file:
@@ -95,7 +95,7 @@ argument matches `eshell-number-regexp'."
   :group 'eshell-util)
 
 (defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
-  "*Regular expression used to match numeric arguments.
+  "Regular expression used to match numeric arguments.
 If `eshell-convert-numeric-arguments' is non-nil, and an argument
 matches this regexp, it will be converted to a Lisp number, using the
 function `string-to-number'."
@@ -103,7 +103,7 @@ function `string-to-number'."
   :group 'eshell-util)
 
 (defcustom eshell-ange-ls-uids nil
-  "*List of user/host/id strings, used to determine remote ownership."
+  "List of user/host/id strings, used to determine remote ownership."
   :type '(repeat (cons :tag "Host for User/UID map"
                       (string :tag "Hostname")
                       (repeat (cons :tag "User/UID List"
@@ -138,27 +138,15 @@ function `string-to-number'."
   (memq system-type '(ms-dos windows-nt)))
 
 (defmacro eshell-condition-case (tag form &rest handlers)
-  "Like `condition-case', but only if `eshell-pass-through-errors' is nil."
+  "If `eshell-handle-errors' is non-nil, this is `condition-case'.
+Otherwise, evaluates FORM with no error handling."
+  (declare (indent 2))
   (if eshell-handle-errors
       `(condition-case ,tag
           ,form
         ,@handlers)
     form))
 
-(put 'eshell-condition-case 'lisp-indent-function 2)
-
-(defmacro eshell-deftest (module name label &rest forms)
-  (if (and (fboundp 'cl-compiling-file) (cl-compiling-file))
-      nil
-    (let ((fsym (intern (concat "eshell-test--" (symbol-name name)))))
-      `(eval-when-compile
-        (ignore
-         (defun ,fsym () ,label
-           (eshell-run-test (quote ,module) (quote ,fsym) ,label
-                            (quote (progn ,@forms)))))))))
-
-(put 'eshell-deftest 'lisp-indent-function 2)
-
 (defun eshell-find-delimiter
   (open close &optional bound reverse-p backslash-p)
   "From point, find the CLOSE delimiter corresponding to OPEN.
@@ -237,6 +225,21 @@ If N or M is nil, it means the end of the list."
            a (last a)))
     a))
 
+(defvar eshell-path-env (getenv "PATH")
+  "Content of $PATH.
+It might be different from \(getenv \"PATH\"\), when
+`default-directory' points to a remote host.")
+
+(defun eshell-parse-colon-path (path-env)
+  "Split string with `parse-colon-path'.
+Prepend remote identification of `default-directory', if any."
+  (let ((remote (file-remote-p default-directory)))
+    (if remote
+       (mapcar
+        (lambda (x) (concat remote x))
+        (parse-colon-path path-env))
+      (parse-colon-path path-env))))
+
 (defun eshell-split-path (path)
   "Split a path into multiple subparts."
   (let ((len (length path))
@@ -271,19 +274,21 @@ If N or M is nil, it means the end of the list."
     text))
 
 (defmacro eshell-for (for-var for-list &rest forms)
-  "Iterate through a list"
+  "Iterate through a list."
+  (declare (indent 2))
   `(let ((list-iter ,for-list))
      (while list-iter
        (let ((,for-var (car list-iter)))
         ,@forms)
        (setq list-iter (cdr list-iter)))))
 
-(put 'eshell-for 'lisp-indent-function 2)
+
+(make-obsolete 'eshell-for 'dolist "24.1")
 
 (defun eshell-flatten-list (args)
   "Flatten any lists within ARGS, so that there are no sublists."
   (let ((new-list (list t)))
-    (eshell-for a args
+    (dolist (a args)
       (if (and (listp a)
               (listp (cdr a)))
          (nconc new-list (eshell-flatten-list a))
@@ -324,20 +329,6 @@ If N or M is nil, it means the end of the list."
   "Flatten and stringify all of the ARGS into a single string."
   (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
 
-;; the next two are from GNUS, and really should be made part of Emacs
-;; some day
-(defsubst eshell-time-less-p (t1 t2)
-  "Say whether time T1 is less than time T2."
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-          (< (nth 1 t1) (nth 1 t2)))))
-
-(defsubst eshell-time-to-seconds (time)
-  "Convert TIME to a floating point number."
-  (+ (* (car time) 65536.0)
-     (cadr time)
-     (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
-
 (defsubst eshell-directory-files (regexp &optional directory)
   "Return a list of files in the given DIRECTORY matching REGEXP."
   (directory-files (or directory default-directory)
@@ -403,7 +394,7 @@ list."
     (unless (listp entries)
       (setq entries (list entries)
            listified t))
-    (eshell-for entry entries
+    (dolist (entry entries)
       (unless (and exclude (string-match exclude entry))
        (setq p predicates valid (null p))
        (while p
@@ -451,7 +442,7 @@ list."
   "Read the contents of /etc/passwd for user names."
   (if (or (not (symbol-value result-var))
          (not (symbol-value timestamp-var))
-         (eshell-time-less-p
+         (time-less-p
           (symbol-value timestamp-var)
           (nth 5 (file-attributes file))))
       (progn
@@ -505,7 +496,7 @@ list."
   "Read the contents of /etc/passwd for user names."
   (if (or (not (symbol-value result-var))
          (not (symbol-value timestamp-var))
-         (eshell-time-less-p
+         (time-less-p
           (symbol-value timestamp-var)
           (nth 5 (file-attributes file))))
       (progn
@@ -519,25 +510,18 @@ list."
       (eshell-read-hosts eshell-hosts-file 'eshell-host-names
                         'eshell-host-timestamp)))
 
-(unless (fboundp 'line-end-position)
-  (defsubst line-end-position (&optional N)
-    (save-excursion (end-of-line N) (point))))
-
-(unless (fboundp 'line-beginning-position)
-  (defsubst line-beginning-position (&optional N)
-    (save-excursion (beginning-of-line N) (point))))
-
-(unless (fboundp 'subst-char-in-string)
-  (defun subst-char-in-string (fromchar tochar string &optional inplace)
-    "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+(and (featurep 'xemacs)
+     (not (fboundp 'subst-char-in-string))
+     (defun subst-char-in-string (fromchar tochar string &optional inplace)
+       "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
 Unless optional argument INPLACE is non-nil, return a new string."
-    (let ((i (length string))
-         (newstr (if inplace string (copy-sequence string))))
-      (while (> i 0)
-       (setq i (1- i))
-       (if (eq (aref newstr i) fromchar)
-           (aset newstr i tochar)))
-      newstr)))
+       (let ((i (length string))
+            (newstr (if inplace string (copy-sequence string))))
+        (while (> i 0)
+          (setq i (1- i))
+          (if (eq (aref newstr i) fromchar)
+              (aset newstr i tochar)))
+        newstr)))
 
 (defsubst eshell-copy-environment ()
   "Return an unrelated copy of `process-environment'."
@@ -577,8 +561,9 @@ Unless optional argument INPLACE is non-nil, return a new string."
          (substring string 0 sublen)
        string)))
 
-(unless (fboundp 'directory-files-and-attributes)
-  (defun directory-files-and-attributes (directory &optional full match nosort)
+(and (featurep 'xemacs)
+     (not (fboundp 'directory-files-and-attributes))
+     (defun directory-files-and-attributes (directory &optional full match nosort id-format)
     "Return a list of names of files and their attributes in DIRECTORY.
 There are three optional arguments:
 If FULL is non-nil, return absolute file names.  Otherwise return names
@@ -590,28 +575,21 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
       (mapcar
        (function
        (lambda (file)
-         (cons file (eshell-file-attributes (expand-file-name file directory)))))
+         (cons file (eshell-file-attributes (expand-file-name file directory)))))
        (directory-files directory full match nosort)))))
 
-(eval-when-compile
-  (defvar ange-cache))
+(defvar ange-cache)
 
-(defun eshell-directory-files-and-attributes (dir &optional full match nosort)
+(defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format)
   "Make sure to use the handler for `directory-file-and-attributes'."
-  (let* ((dir (expand-file-name dir))
-        (dfh (find-file-name-handler dir 'directory-files)))
-    (if (not dfh)
-       (directory-files-and-attributes dir full match nosort)
-      (let ((files (funcall dfh 'directory-files dir full match nosort))
-           (fah (find-file-name-handler dir 'file-attributes)))
-       (mapcar
-        (function
-         (lambda (file)
-           (cons file (if fah
-                          (eshell-file-attributes
-                           (expand-file-name file dir))
-                        (file-attributes (expand-file-name file dir))))))
-        files)))))
+  (let* ((dir (expand-file-name dir)))
+    (if (string-equal (file-remote-p dir 'method) "ftp")
+       (let ((files (directory-files dir full match nosort)))
+         (mapcar
+          (lambda (file)
+            (cons file (eshell-file-attributes (expand-file-name file dir))))
+          files))
+      (directory-files-and-attributes dir full match nosort id-format))))
 
 (defun eshell-current-ange-uids ()
   (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
@@ -628,10 +606,23 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
     (autoload 'parse-time-string "parse-time"))
 
 (eval-when-compile
-  (require 'ange-ftp nil t))
+  (require 'ange-ftp nil t)
+  (require 'tramp nil t))
 
 (defun eshell-parse-ange-ls (dir)
-  (let (entry)
+  (let ((ange-ftp-name-format
+        (list (nth 0 tramp-file-name-structure)
+              (nth 3 tramp-file-name-structure)
+              (nth 2 tramp-file-name-structure)
+              (nth 4 tramp-file-name-structure)))
+       ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
+       ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
+       ;; there could be incorrect values from previous calls in case the
+       ;; "ftp" method is used in the Tramp file name. So we unset
+       ;; those values.
+       (ange-ftp-ftp-name-arg "")
+       (ange-ftp-ftp-name-res nil)
+       entry)
     (with-temp-buffer
       (insert (ange-ftp-ls dir "-la" nil))
       (goto-char (point-min))
@@ -650,6 +641,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
               (user (match-string 3))
               (group (match-string 4))
               (size (string-to-number (match-string 5)))
+              (name (ange-ftp-parse-filename))
               (mtime
                (if (fboundp 'parse-time-string)
                    (let ((moment (parse-time-string
@@ -662,7 +654,6 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
                        (setcar (nthcdr 2 moment) 0))
                      (apply 'encode-time moment))
                  (ange-ftp-file-modtime (expand-file-name name dir))))
-              (name (ange-ftp-parse-filename))
               symlink)
          (if (string-match "\\(.+\\) -> \\(.+\\)" name)
              (setq symlink (match-string 2 name)
@@ -679,32 +670,32 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
        (forward-line)))
     entry))
 
-(defun eshell-file-attributes (file)
-  "Return the attributes of FILE, playing tricks if it's over ange-ftp."
+(defun eshell-file-attributes (file &optional id-format)
+  "Return the attributes of FILE, playing tricks if it's over ange-ftp.
+The optional argument ID-FORMAT specifies the preferred uid and
+gid format.  Valid values are 'string and 'integer, defaulting to
+'integer.  See `file-attributes'."
   (let* ((file (expand-file-name file))
-        (handler (find-file-name-handler file 'file-attributes))
         entry)
-    (if (not handler)
-       (file-attributes file)
-      (if (eq (find-file-name-handler (file-name-directory file)
-                                     'directory-files)
-             'ange-ftp-hook-function)
-         (let ((base (file-name-nondirectory file))
-               (dir (file-name-directory file)))
+    (if (string-equal (file-remote-p file 'method) "ftp")
+       (let ((base (file-name-nondirectory file))
+             (dir (file-name-directory file)))
+         (if (string-equal "" base) (setq base "."))
+         (if (boundp 'ange-cache)
+             (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
+         (unless entry
+           (setq entry (eshell-parse-ange-ls dir))
            (if (boundp 'ange-cache)
-               (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
-           (unless entry
-             (setq entry (eshell-parse-ange-ls dir))
-             (if (boundp 'ange-cache)
-                 (setq ange-cache
-                       (cons (cons dir entry)
-                             ange-cache)))
-             (if entry
-                 (let ((fentry (assoc base (cdr entry))))
-                   (if fentry
-                       (setq entry (cdr fentry))
-                     (setq entry nil)))))))
-      (or entry (funcall handler 'file-attributes file)))))
+               (setq ange-cache
+                     (cons (cons dir entry)
+                           ange-cache)))
+           (if entry
+               (let ((fentry (assoc base (cdr entry))))
+                 (if fentry
+                     (setq entry (cdr fentry))
+                   (setq entry nil)))))
+         entry)
+      (file-attributes file id-format))))
 
 (defalias 'eshell-copy-tree 'copy-tree)
 
@@ -779,5 +770,4 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
 
 (provide 'esh-util)
 
-;; arch-tag: 70159778-5c7a-480a-bae4-3ad332fca19d
 ;;; esh-util.el ends here