]> code.delx.au - gnu-emacs/blobdiff - lisp/ange-ftp.el
(tmm-menubar-mouse): Add autoload cookie.
[gnu-emacs] / lisp / ange-ftp.el
index cf3141c91ed36f52198eb9b1e1d8d63c142dad7e..2b79cf5757a89305b762aae6f235b11eaeebde21 100644 (file)
 ;;;    when asked to list a non-existent directory.  Some of the ai.mit.edu
 ;;;    machines cause this problem for some FTP clients. Using
 ;;;    ange-ftp-kill-ftp-process can restart the ftp process, which
-;;;    should get things back in synch.
+;;;    should get things back in sync.
 ;;;
 ;;; 3. Ange-ftp does not check to make sure that when creating a new file,
 ;;;    you provide a valid filename for the remote operating system.
@@ -653,6 +653,7 @@ parenthesized expressions in REGEXP for the components (in that order).")
 (defvar ange-ftp-skip-msgs
   (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
          "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
+         "^Data connection \\|"
          "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye")
   "*Regular expression matching ftp messages that can be ignored.")
 
@@ -926,9 +927,12 @@ SIZE, if supplied, should be a prime number."
 Args are as in `message': a format string, plus arguments to be formatted."
   (let ((msg (apply (function format) fmt args))
        (max (window-width (minibuffer-window))))
-    (if (>= (length msg) max)
-       (setq msg (concat "> " (substring msg (- 3 max)))))
-    (message "%s" msg)))
+    (if noninteractive
+       msg
+      (if (>= (length msg) max)
+         ;; Take just the last MAX - 3 chars of the string.
+         (setq msg (concat "> " (substring msg (- 3 max)))))
+      (message "%s" msg))))
 
 (defun ange-ftp-abbreviate-filename (file &optional new)
   "Abbreviate the file name FILE relative to the default-directory.
@@ -1195,9 +1199,11 @@ Optional DEFAULT is password to start with."
   ;; We set this before actually doing it to avoid the possibility
   ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
   (interactive)
-  (let* ((file (ange-ftp-chase-symlinks
-               (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
-        (attr (ange-ftp-real-file-attributes file)))
+  (let (file attr)
+    (let ((default-directory "/"))
+      (setq file (ange-ftp-chase-symlinks
+                 (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
+      (setq attr (ange-ftp-real-file-attributes file)))
     (if (and attr                      ; file exists.
             (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed
        (save-match-data
@@ -1270,7 +1276,7 @@ Optional DEFAULT is password to start with."
     (setq ange-ftp-ftp-name-arg name
          ange-ftp-ftp-name-res
          (save-match-data
-           (if (string-match (car ange-ftp-name-format) name)
+           (if (posix-string-match (car ange-ftp-name-format) name)
                (let* ((ns (cdr ange-ftp-name-format))
                       (host (ange-ftp-ftp-name-component 0 ns name))
                       (user (ange-ftp-ftp-name-component 1 ns name))
@@ -1284,7 +1290,7 @@ Optional DEFAULT is password to start with."
 ;; replace the name component with NAME.
 (defun ange-ftp-replace-name-component (fullname name)
   (save-match-data
-    (if (string-match (car ange-ftp-name-format) fullname)
+    (if (posix-string-match (car ange-ftp-name-format) fullname)
        (let* ((ns (cdr ange-ftp-name-format))
               (elt (nth 2 ns)))
          (concat (substring fullname 0 (match-beginning elt))
@@ -1416,7 +1422,8 @@ good, skip, fatal, or unknown."
        ange-ftp-hash-mark-count (+ (- (match-end 0)
                                       (match-beginning 0))
                                    ange-ftp-hash-mark-count))
-  (and ange-ftp-process-msg
+  (and ange-ftp-hash-mark-unit
+       ange-ftp-process-msg
        ange-ftp-process-verbose
        (not (eq (selected-window) (minibuffer-window)))
        (not (boundp 'search-message))  ;screws up isearch otherwise
@@ -1460,8 +1467,7 @@ good, skip, fatal, or unknown."
              (set-buffer (process-buffer proc))
              
              ;; handle hash mark printing
-             (and ange-ftp-hash-mark-unit
-                  ange-ftp-process-busy
+             (and ange-ftp-process-busy
                   (string-match "^#+$" str)
                   (setq str (ange-ftp-process-handle-hash str)))
              (comint-output-filter proc str)
@@ -1517,7 +1523,7 @@ good, skip, fatal, or unknown."
 (defun ange-ftp-process-sentinel (proc str)
   "When ftp process changes state, nuke all file-entries in cache."
   (let ((name (process-name proc)))
-    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name)
+    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
        (let ((user (substring name (match-beginning 1) (match-end 1)))
              (host (substring name (match-beginning 2) (match-end 2))))
          (ange-ftp-wipe-file-entries host user))))
@@ -1596,8 +1602,10 @@ good, skip, fatal, or unknown."
 
 (defun ange-ftp-gwp-filter (proc str)
   (comint-output-filter proc str)
-  ;; Replace STR by the result of the comint processing.
-  (setq str (buffer-substring comint-last-output-start (process-mark proc)))
+  (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)
         (send-string proc
                      (concat
@@ -1770,7 +1778,10 @@ on the gateway machine to do the ftp instead."
     ;; It would be nice to make process-connection-type nil,
     ;; but that doesn't work: ftp never responds.
     ;; Can anyone find a fix for that?
-    (let ((process-connection-type t))
+    (let ((process-connection-type t)
+         (process-environment process-environment))
+      ;; This tells GNU ftp not to output any fancy escape sequences.
+      (setenv "TERM" "dumb")
       (if use-gateway
          (if ange-ftp-gateway-program-interactive
              (setq proc (ange-ftp-gwp-start host user name args))
@@ -1818,6 +1829,10 @@ on the gateway machine to do the ftp instead."
     (setq ange-ftp-process-result-line "")
 
     (setq comint-prompt-regexp "^ftp> ")
+    (make-local-variable 'comint-password-prompt-regexp)
+    ;; This is a regexp that can't match anything.
+    ;; ange-ftp has its own ways of handling passwords.
+    (setq comint-password-prompt-regexp "^a\\'z")
     (make-local-variable 'paragraph-start)
     (setq paragraph-start comint-prompt-regexp)))
 
@@ -1856,9 +1871,10 @@ host specified in ``ange-ftp-gateway-host''."
 (defun ange-ftp-normal-login (host user pass account proc)
   "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
 PROC is the process to the FTP-client."
-  (let ((result (ange-ftp-raw-send-cmd
+  (let* ((nshost (ange-ftp-nslookup-host host))
+        (result (ange-ftp-raw-send-cmd
                 proc
-                (format "open %s" (ange-ftp-nslookup-host host))
+                (format "open %s" nshost)
                 (format "Opening FTP connection to %s" host))))
     (or (car result)
        (ange-ftp-error host user
@@ -1866,7 +1882,9 @@ PROC is the process to the FTP-client."
                                (cdr result))))
     (setq result (ange-ftp-raw-send-cmd
                  proc
-                 (format "user \"%s\" %s %s" user pass account)
+                 (if (ange-ftp-use-smart-gateway-p host)
+                     (format "user \"%s\"@%s %s %s" user nshost pass account)
+                   (format "user \"%s\" %s %s" user pass account))
                  (format "Logging in as user %s@%s" user host)))
     (or (car result)
        (progn
@@ -2194,7 +2212,7 @@ Works by doing a pwd and examining the directory syntax."
 ;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
 ;; to take switch arguments.
 (defun ange-ftp-dumb-unix-host (host)
-  (and ange-ftp-dumb-unix-host-regexp
+  (and host ange-ftp-dumb-unix-host-regexp
        (save-match-data
         (string-match ange-ftp-dumb-unix-host-regexp host))))
 
@@ -2224,7 +2242,7 @@ which can parse the output from a DIR listing for a host of type TYPE.")
 ;; 
 ;; With no-error t, it returns:
 ;; an error if not an ange-ftp-name
-;; error if listing is unreable (most likely caused by a slow connection)
+;; error if listing is unreadable (most likely caused by a slow connection)
 ;; nil if ftp error (this is because although asking to list a nonexistent
 ;;                   directory on a remote unix machine usually (except
 ;;                   maybe for dumb hosts) returns an ls error, but no
@@ -3688,7 +3706,8 @@ system TYPE.")
        (while (and tryfiles (not copy))
          (condition-case error
              (setq copy (ange-ftp-file-local-copy (car tryfiles)))
-           (ftp-error nil)))
+           (ftp-error nil))
+         (setq tryfiles (cdr tryfiles)))
        (if copy
            (unwind-protect
                (funcall 'load copy noerror nomessage nosuffix)
@@ -3818,10 +3837,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 
 ;;; This regexp takes care of real ange-ftp file names (with a slash
 ;;; and colon).
+;;; Don't allow the host name to end in a period--some systems use /.:
 ;;;###autoload
-(or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist)
+(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
     (setq file-name-handler-alist
-         (cons '("^/[^/:]*[^/:]:" . ange-ftp-hook-function)
+         (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
                file-name-handler-alist)))
 
 ;;; This regexp recognizes and absolute filenames with only one component,
@@ -4826,7 +4846,7 @@ Other orders of $ and _ seem to all work just fine.")
 ;;       (cons '(vms . ange-ftp-dired-vms-ls-trim)
 ;;             ange-ftp-dired-ls-trim-alist))) 
 
-(defun ange-ftp-vms-sans-version (name)
+(defun ange-ftp-vms-sans-version (name &rest args)
   (save-match-data
     (if (string-match ";[0-9]+$" name)
        (substring name 0 (match-beginning 0))