[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/ange-ftp.el |
|
Date: |
Mon, 03 Oct 2005 17:19:17 -0400 |
Index: emacs/lisp/net/ange-ftp.el
diff -c emacs/lisp/net/ange-ftp.el:1.75 emacs/lisp/net/ange-ftp.el:1.76
*** emacs/lisp/net/ange-ftp.el:1.75 Sun Oct 2 15:54:02 2005
--- emacs/lisp/net/ange-ftp.el Mon Oct 3 21:19:15 2005
***************
*** 1387,1398 ****
(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
;; 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*"))
(ange-ftp-real-insert-file-contents file)
(setq buffer-file-name file)
(setq default-directory (file-name-directory file))
--- 1387,1398 ----
(if (or ange-ftp-disable-netrc-security-check
(and (eq (nth 2 attr) (user-uid)) ; Same uids.
(string-match ".r..------" (nth 8 attr))))
! (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.
! (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,1519 ****
(setq buffer (current-buffer))
(setq buffer (get-buffer buffer)))
(let ((file (or (buffer-file-name buffer)
! (save-excursion (set-buffer buffer) default-directory))))
(if file
(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
(if parsed
--- 1513,1519 ----
(setq buffer (current-buffer))
(setq buffer (get-buffer buffer)))
(let ((file (or (buffer-file-name buffer)
! (with-current-buffer buffer default-directory))))
(if file
(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
(if parsed
***************
*** 1594,1601 ****
(if proc
(let ((buf (process-buffer proc)))
(if buf
! (save-excursion
! (set-buffer buf)
(setq ange-ftp-xfer-size
;; For very large files, BYTES can be a float.
(if (integerp bytes)
--- 1594,1600 ----
(if proc
(let ((buf (process-buffer proc)))
(if buf
! (with-current-buffer buf
(setq ange-ftp-xfer-size
;; For very large files, BYTES can be a float.
(if (integerp bytes)
***************
*** 1765,1772 ****
(defun ange-ftp-gwp-filter (proc str)
(comint-output-filter proc str)
! (save-excursion
! (set-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)
--- 1764,1770 ----
(defun ange-ftp-gwp-filter (proc str)
(comint-output-filter proc str)
! (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,1915 ****
ange-ftp-nslookup-program host)))
(res host))
(set-process-query-on-exit-flag proc nil)
! (save-excursion
! (set-buffer (process-buffer proc))
(while (memq (process-status proc) '(run open))
(accept-process-output proc))
(goto-char (point-min))
--- 1906,1912 ----
ange-ftp-nslookup-program host)))
(res host))
(set-process-query-on-exit-flag proc nil)
! (with-current-buffer (process-buffer proc)
(while (memq (process-status proc) '(run open))
(accept-process-output proc))
(goto-char (point-min))
***************
*** 1948,1955 ****
;; 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)
(internal-ange-ftp-mode))
;; This tells GNU ftp not to output any fancy escape sequences.
(setenv "TERM" "dumb")
--- 1945,1951 ----
;; Copy this so we don't alter it permanently.
(process-environment (copy-tree process-environment))
(buffer (get-buffer-create name)))
! (with-current-buffer buffer
(internal-ange-ftp-mode))
;; This tells GNU ftp not to output any fancy escape sequences.
(setenv "TERM" "dumb")
***************
*** 1961,1968 ****
ange-ftp-gateway-host)
args))))
(setq proc (apply 'start-process name name args))))
! (save-excursion
! (set-buffer (process-buffer proc))
(goto-char (point-max))
(set-marker (process-mark proc) (point)))
(set-process-query-on-exit-flag proc nil)
--- 1957,1963 ----
ange-ftp-gateway-host)
args))))
(setq proc (apply 'start-process name name args))))
! (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,2135 ****
(defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash
! (save-excursion
! (set-buffer (process-buffer proc))
(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
(line (cdr status)))
(save-match-data
--- 2123,2129 ----
(defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash
! (with-current-buffer (process-buffer proc)
(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
(line (cdr status)))
(save-match-data
***************
*** 2309,2314 ****
--- 2303,2316 ----
(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,2615 ****
(format "Listing %s"
(ange-ftp-abbreviate-filename
ange-ftp-this-file)))))
! (save-excursion
! (set-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)
--- 2609,2616 ----
(format "Listing %s"
(ange-ftp-abbreviate-filename
ange-ftp-this-file)))))
! (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,3030 ****
(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)))
(and ange-ftp-binary-hash-mark-size
(setq ange-ftp-hash-mark-unit
(ash ange-ftp-binary-hash-mark-size -4)))))))
--- 3024,3030 ----
(let ((result (ange-ftp-send-cmd host user '(type "binary"))))
(if (not (car result))
(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
! (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,3041 ****
(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)))
(and ange-ftp-ascii-hash-mark-size
(setq ange-ftp-hash-mark-unit
(ash ange-ftp-ascii-hash-mark-size -4)))))))
--- 3034,3040 ----
(let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
(if (not (car result))
(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
! (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,3296 ****
;; cleanup forms
(setq coding-system-used last-coding-system-used)
(setq buffer-file-name filename)
! (set-buffer-modified-p mod-p)))
(if binary
(ange-ftp-set-binary-mode host user))
--- 3289,3295 ----
;; cleanup forms
(setq coding-system-used last-coding-system-used)
(setq buffer-file-name filename)
! (restore-buffer-modified-p mod-p)))
(if binary
(ange-ftp-set-binary-mode host user))
***************
*** 3643,3650 ****
;; (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
! ;; (save-excursion
! ;; (set-buffer (process-buffer proc))
;; (let ((cont copy-cont)
;; (result (buffer-string)))
;; (unwind-protect
--- 3642,3648 ----
;; (set (make-local-variable 'copy-cont) cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
! ;; (with-current-buffer (process-buffer proc)
;; (let ((cont copy-cont)
;; (result (buffer-string)))
;; (unwind-protect
***************
*** 4481,4494 ****
(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))))))
(insert
(cond
(wildcard
--- 4479,4488 ----
(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)
! ;; 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,4680 ****
;; 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)
;; (if (null fn-list)
;; (ange-ftp-dcf-3 failures operation total skipped
;; success-count buffer)
--- 4665,4671 ----
;; target marker-char buffer overwrite-query
;; overwrite-backup-query failures skipped
;; success-count total)
! ;; (with-current-buffer buffer
;; (if (null fn-list)
;; (ange-ftp-dcf-3 failures operation total skipped
;; success-count buffer)
***************
*** 4746,4753 ****
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
! ;; total))))))))
! ;; (set-buffer old-buf))))
;;(defun ange-ftp-dcf-2 (result line err
;; file-creator operation fn-list
--- 4737,4743 ----
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
! ;; total)))))))))
;;(defun ange-ftp-dcf-2 (result line err
;; file-creator operation fn-list
***************
*** 4761,4770 ****
;; overwrite-backup-query
;; failures skipped success-count
;; total)
! ;; (let ((old-buf (current-buffer)))
! ;; (unwind-protect
! ;; (progn
! ;; (set-buffer buffer)
;; (if (or err (not result))
;; (progn
;; (setq failures (cons (dired-make-relative from) failures))
--- 4751,4757 ----
;; overwrite-backup-query
;; failures skipped success-count
;; total)
! ;; (with-current-buffer buffer
;; (if (or err (not result))
;; (progn
;; (setq failures (cons (dired-make-relative from) failures))
***************
*** 4787,4801 ****
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
! ;; total))
! ;; (set-buffer old-buf))))
;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;; buffer)
! ;; (let ((old-buf (current-buffer)))
! ;; (unwind-protect
! ;; (progn
! ;; (set-buffer buffer)
;; (cond
;; (failures
;; (dired-log-summary
--- 4774,4784 ----
;; overwrite-query
;; overwrite-backup-query
;; failures skipped success-count
! ;; total)))
;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
;; buffer)
! ;; (with-current-buffer buffer
;; (cond
;; (failures
;; (dired-log-summary
***************
*** 4810,4817 ****
;; (t
;; (message "%s: %s file%s."
;; operation success-count (dired-plural-s success-count))))
! ;; (dired-move-to-filename))
! ;; (set-buffer old-buf))))
;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support
--- 4793,4799 ----
;; (t
;; (message "%s: %s file%s."
;; operation success-count (dired-plural-s success-count))))
! ;; (dired-move-to-filename)))
;;;; -----------------------------------------------
;;;; Unix Descriptive Listing (dl) Support