Sync to HEAD

[bpt/emacs.git] / lisp / net / ange-ftp.el

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index a315482..8e1068a 100644 (file)
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -686,7 +686,7 @@
   :prefix "ange-ftp-")
 
 (defcustom ange-ftp-name-format
-  '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
+  '("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
   "*Format of a fully expanded remote file name.
 
 This is a list of the form \(REGEXP HOST USER NAME\),
@@ -694,7 +694,7 @@ where REGEXP is a regular expression matching
 the full remote name, and HOST, USER, and NAME are the numbers of
 parenthesized expressions in REGEXP for the components (in that order)."
   :group 'ange-ftp
-  :type '(list regexp
+  :type '(list (regexp  :tag "Name regexp")
               (integer :tag "Host group")
               (integer :tag "User group")
               (integer :tag "Name group")))
@@ -1469,14 +1469,15 @@ only return the directory part of FILE."
 ;; Display the last chunk of output from the ftp process for the given HOST
 ;; USER pair, and signal an error including MSG in the text.
 (defun ange-ftp-error (host user msg)
-  (let ((cur (selected-window))
-       (pop-up-windows t))
-    (pop-to-buffer
-     (get-buffer-create
-      (ange-ftp-ftp-process-buffer host user)))
-    (goto-char (point-max))
-    (select-window cur))
-  (signal 'ftp-error (list (format "FTP Error: %s" msg))))
+  (save-excursion  ;; Prevent pop-to-buffer from changing current buffer.
+    (let ((cur (selected-window))
+         (pop-up-windows t))
+      (pop-to-buffer
+       (get-buffer-create
+       (ange-ftp-ftp-process-buffer host user)))
+      (goto-char (point-max))
+      (select-window cur))
+    (signal 'ftp-error (list (format "FTP Error: %s" msg)))))
 
 (defun ange-ftp-set-buffer-mode ()
   "Set correct modes for the current buffer if visiting a remote file."
@@ -1917,7 +1918,8 @@ on the gateway machine to do the ftp instead."
     ;; but that doesn't work: ftp never responds.
     ;; Can anyone find a fix for that?
     (let ((process-connection-type t)
-         (process-environment process-environment)
+         ;; Copy this so we don't alter it permanently.
+         (process-environment (copy-tree process-environment))
          (buffer (get-buffer-create name)))
       (save-excursion
        (set-buffer buffer)
@@ -3433,7 +3435,7 @@ system TYPE.")
          (nreverse files)))
     (apply 'ange-ftp-real-directory-files directory full match v19-args)))
 
-(defun ange-ftp-file-attributes (file)
+(defun ange-ftp-file-attributes (file &optional id-format)
   (setq file (expand-file-name file))
   (let ((parsed (ange-ftp-ftp-name file)))
     (if parsed
@@ -3466,7 +3468,9 @@ system TYPE.")
                      inode             ;10 "inode number".
                      -1                ;11 device number [v19 only]
                      ))))
-      (ange-ftp-real-file-attributes file))))
+      (if id-format
+         (ange-ftp-real-file-attributes file id-format)
+       (ange-ftp-real-file-attributes file)))))
 
 (defun ange-ftp-file-newer-than-file-p (f1 f2)
   (let ((f1-parsed (ange-ftp-ftp-name f1))
@@ -6048,4 +6052,5 @@ be recognized automatically (they are all valid BS2000 hosts too)."
 
 (provide 'ange-ftp)
 
+;;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
 ;;; ange-ftp.el ends here