Mercurial > emacs

changeset 65810:0534e10b621e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use with-current-buffer. (ange-ftp-insert-directory): Do not follow symlinks any more.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 03 Oct 2005 21:19:15 +0000
parents f528ccbc5de9
children 8b5704a2934a
files lisp/net/ange-ftp.el
diffstat 1 files changed, 33 insertions(+), 51 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/net/ange-ftp.el	Mon Oct 03 20:46:29 2005 +0000
+++ b/lisp/net/ange-ftp.el	Mon Oct 03 21:19:15 2005 +0000
@@ -1387,12 +1387,12 @@
 	  (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 @@
       (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 @@
     (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 @@
 
 (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 @@
 				   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 @@
 	  ;; 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 @@
 					    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 @@
 
 (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 @@
 	   (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 @@
 				       (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 @@
   (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 @@
   (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 @@
 		    ;; 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 @@
 ;;       (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 @@
 (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 @@
 ;;		       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 @@
 ;;				     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 @@
 ;;			      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 @@
 ;;			  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 @@
 ;;	   (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