Use with-current-buffer.

(ange-ftp-insert-directory): Do not follow symlinks any more.

1 files changed, 33 insertions, 51 deletions

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index e3fd69924d4..9061dcac38f 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1387,12 +1387,12 @@ only return the directory part of FILE."
           (if (or ange-ftp-disable-netrc-security-check
                   (and (eq (nth 2 attr) (user-uid)) ; Same uids.
                        (string-match ".r..------" (nth 8 attr))))
-              (save-excursion
+              (with-current-buffer
                 ;; we are cheating a bit here.  I'm trying to do the equivalent
                 ;; of find-file on the .netrc file, but then nuke it afterwards.
                 ;; with the bit of logic below we should be able to have
                 ;; encrypted .netrc files.
-                (set-buffer (generate-new-buffer "*ftp-.netrc*"))
+                  (generate-new-buffer "*ftp-.netrc*")
                 (ange-ftp-real-insert-file-contents file)
                 (setq buffer-file-name file)
                 (setq default-directory (file-name-directory file))
@@ -1513,7 +1513,7 @@ then kill the related ftp process."
       (setq buffer (current-buffer))
     (setq buffer (get-buffer buffer)))
   (let ((file (or (buffer-file-name buffer)
-                  (save-excursion (set-buffer buffer) default-directory))))
+                  (with-current-buffer buffer default-directory))))
     (if file
         (let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
           (if parsed
@@ -1594,8 +1594,7 @@ good, skip, fatal, or unknown."
     (if proc
         (let ((buf (process-buffer proc)))
           (if buf
-              (save-excursion
-                (set-buffer buf)
+              (with-current-buffer buf
                 (setq ange-ftp-xfer-size
                       ;; For very large files, BYTES can be a float.
                       (if (integerp bytes)
@@ -1765,8 +1764,7 @@ good, skip, fatal, or unknown."
 
 (defun ange-ftp-gwp-filter (proc str)
   (comint-output-filter proc str)
-  (save-excursion
-    (set-buffer (process-buffer proc))
+  (with-current-buffer (process-buffer proc)
     ;; Replace STR by the result of the comint processing.
     (setq str (buffer-substring comint-last-output-start (process-mark proc))))
   (cond ((string-match "login: *$" str)
@@ -1908,8 +1906,7 @@ been queued with no result.  CONT will still be called, however."
                                    ange-ftp-nslookup-program host)))
             (res host))
         (set-process-query-on-exit-flag proc nil)
-        (save-excursion
-          (set-buffer (process-buffer proc))
+        (with-current-buffer (process-buffer proc)
           (while (memq (process-status proc) '(run open))
             (accept-process-output proc))
           (goto-char (point-min))
@@ -1948,8 +1945,7 @@ on the gateway machine to do the ftp instead."
           ;; 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)
+      (with-current-buffer buffer
         (internal-ange-ftp-mode))
       ;; This tells GNU ftp not to output any fancy escape sequences.
       (setenv "TERM" "dumb")
@@ -1961,8 +1957,7 @@ on the gateway machine to do the ftp instead."
                                             ange-ftp-gateway-host)
                                       args))))
         (setq proc (apply 'start-process name name args))))
-    (save-excursion
-      (set-buffer (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
       (goto-char (point-max))
       (set-marker (process-mark proc) (point)))
     (set-process-query-on-exit-flag proc nil)
@@ -2128,8 +2123,7 @@ suffix of the form #PORT to specify a non-default port"
 
 (defun ange-ftp-guess-hash-mark-size (proc)
   (if ange-ftp-send-hash
-      (save-excursion
-        (set-buffer (process-buffer proc))
+      (with-current-buffer (process-buffer proc)
         (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
                (line (cdr status)))
           (save-match-data
@@ -2309,6 +2303,14 @@ and NOWAIT."
            (not (string-match "R" cmd3))
            (setq cmd1 (concat cmd1 ".")))
 
+      ;; Using "ls -flags foo" has several problems:
+      ;; - if foo is a symlink, we may get a single line showing the symlink
+      ;;   rather than the listing of the directory it points to.
+      ;; - if "foo" has spaces, the parsing of the command may be done wrong.
+      ;; - some version of netbsd's ftpd only accept a single argument after
+      ;;   `ls', which can either be the directory or the flags.
+      ;; So to work around those problems, we use "cd foo; ls -flags".
+
       ;; If the dir name contains a space, some ftp servers will
       ;; refuse to list it.  We instead change directory to the
       ;; directory in question and ls ".".
@@ -2607,9 +2609,8 @@ away in the internal cache."
                                        (format "Listing %s"
                                                (ange-ftp-abbreviate-filename
                                                 ange-ftp-this-file)))))
-                    (save-excursion
-                      (set-buffer (get-buffer-create
-                                   ange-ftp-data-buffer-name))
+                    (with-current-buffer (get-buffer-create
+                                          ange-ftp-data-buffer-name))
                       (erase-buffer)
                       (if (ange-ftp-real-file-readable-p temp)
                           (ange-ftp-real-insert-file-contents temp)
@@ -3023,8 +3024,7 @@ this also returns nil."
   (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
     (if (not (car result))
         (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
-      (save-excursion
-        (set-buffer (process-buffer (ange-ftp-get-process host user)))
+      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
         (and ange-ftp-binary-hash-mark-size
              (setq ange-ftp-hash-mark-unit
                    (ash ange-ftp-binary-hash-mark-size -4)))))))
@@ -3034,8 +3034,7 @@ this also returns nil."
   (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
     (if (not (car result))
         (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
-      (save-excursion
-        (set-buffer (process-buffer (ange-ftp-get-process host user)))
+      (with-current-buffer (process-buffer (ange-ftp-get-process host user))
         (and ange-ftp-ascii-hash-mark-size
              (setq ange-ftp-hash-mark-unit
                    (ash ange-ftp-ascii-hash-mark-size -4)))))))
@@ -3290,7 +3289,7 @@ system TYPE.")
                     ;; cleanup forms
                     (setq coding-system-used last-coding-system-used)
                     (setq buffer-file-name filename)
-                    (set-buffer-modified-p mod-p)))
+                    (restore-buffer-modified-p mod-p)))
                 (if binary
                     (ange-ftp-set-binary-mode host user))
 
@@ -3643,8 +3642,7 @@ Value is (0 0) if the modification time cannot be determined."
 ;;       (set (make-local-variable 'copy-cont) cont))))
 ;;
 ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
-;;   (save-excursion
-;;     (set-buffer (process-buffer proc))
+;;   (with-current-buffer (process-buffer proc)
 ;;     (let ((cont copy-cont)
 ;;        (result (buffer-string)))
 ;;       (unwind-protect
@@ -4481,14 +4479,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (defun ange-ftp-insert-directory (file switches &optional wildcard full)
   (if (not (ange-ftp-ftp-name (expand-file-name file)))
       (ange-ftp-real-insert-directory file switches wildcard full)
-    ;; Follow symlinks.
-    (let (tem)
-      (while (and (not wildcard)
-                  (stringp (setq tem (file-symlink-p
-                                      (directory-file-name file)))))
-        (setq file
-              (ange-ftp-expand-symlink
-               tem (file-name-directory (directory-file-name file))))))
+    ;; We used to follow symlinks on `file' here.  Apparently it was done
+    ;; because some FTP servers react to "ls foo" by listing the symlink foo
+    ;; rather than the directory it points to.  Now that ange-ftp-ls uses
+    ;; "cd foo; ls" instead, this is not necesssary any more.
     (insert
      (cond
       (wildcard
@@ -4671,10 +4665,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                     target marker-char buffer overwrite-query
 ;;                     overwrite-backup-query failures skipped
 ;;                     success-count total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;      (progn
-;;        (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;        (if (null fn-list)
 ;;            (ange-ftp-dcf-3 failures operation total skipped
 ;;                            success-count buffer)
@@ -4746,8 +4737,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                                   overwrite-query
 ;;                                   overwrite-backup-query
 ;;                                   failures skipped success-count
-;;                                   total))))))))
-;;      (set-buffer old-buf))))
+;;                                   total)))))))))
 
 ;;(defun ange-ftp-dcf-2 (result line err
 ;;                            file-creator operation fn-list
@@ -4761,10 +4751,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                            overwrite-backup-query
 ;;                            failures skipped success-count
 ;;                            total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;      (progn
-;;        (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;        (if (or err (not result))
 ;;            (progn
 ;;              (setq failures (cons (dired-make-relative from) failures))
@@ -4787,15 +4774,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;                        overwrite-query
 ;;                        overwrite-backup-query
 ;;                        failures skipped success-count
-;;                        total))
-;;      (set-buffer old-buf))))
+;;                        total)))
 
 ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
 ;;                              buffer)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;      (progn
-;;        (set-buffer buffer)
+;;  (with-current-buffer buffer
 ;;        (cond
 ;;         (failures
 ;;          (dired-log-summary
@@ -4810,8 +4793,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 ;;         (t
 ;;          (message "%s: %s file%s."
 ;;                   operation success-count (dired-plural-s success-count))))
-;;        (dired-move-to-filename))
-;;      (set-buffer old-buf))))
+;;        (dired-move-to-filename)))
 
 ;;;; -----------------------------------------------
 ;;;; Unix Descriptive Listing (dl) Support