Use with-current-buffer.

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

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index e3fd69924d4781369de1a294984e7b8cc919b682..9061dcac38f66f7c275200f63bfb1cdef81ab4b7 100644 (file)
--- 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)))
 \f
 ;;;; -----------------------------------------------
 ;;;; Unix Descriptive Listing (dl) Support