# HG changeset patch # User Stefan Monnier # Date 1128374355 0 # Node ID 0534e10b621ea467c4717c0c1550cd91c7ffffe6 # Parent f528ccbc5de9bb2f4a6823dff2e03c26bd1f49d7 Use with-current-buffer. (ange-ftp-insert-directory): Do not follow symlinks any more. diff -r f528ccbc5de9 -r 0534e10b621e lisp/net/ange-ftp.el --- 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