Change release version from 21.4 to 22.1 throughout.

[bpt/emacs.git] / lisp / net / ange-ftp.el

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index b96e7f1..8b4ed89 100644 (file)
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -686,7 +686,7 @@
   :prefix "ange-ftp-")
 
 (defcustom ange-ftp-name-format
-  '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
+  '("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
   "*Format of a fully expanded remote file name.
 
 This is a list of the form \(REGEXP HOST USER NAME\),
@@ -694,7 +694,7 @@ where REGEXP is a regular expression matching
 the full remote name, and HOST, USER, and NAME are the numbers of
 parenthesized expressions in REGEXP for the components (in that order)."
   :group 'ange-ftp
-  :type '(list regexp
+  :type '(list (regexp  :tag "Name regexp")
               (integer :tag "Host group")
               (integer :tag "User group")
               (integer :tag "Name group")))
@@ -1004,7 +1004,7 @@ or nil meaning don't change it."
   :type '(repeat (cons regexp (choice (const :tag "On" "on")
                                      (const :tag "Off" "off")
                                      (const :tag "Don't change" nil))))
-  :version "21.4")
+  :version "22.1")
 \f
 ;;;; ------------------------------------------------------------
 ;;;; Hash table support.
@@ -1014,7 +1014,7 @@ or nil meaning don't change it."
 
 (defun ange-ftp-hash-entry-exists-p (key tbl)
   "Return whether there is an association for KEY in TABLE."
-  (not (eq (gethash key tbl 'unknown) 'unknown)))
+  (and tbl (not (eq (gethash key tbl 'unknown) 'unknown))))
 
 (defun ange-ftp-hash-table-keys (tbl)
   "Return a sorted list of all the active keys in TABLE, as strings."
@@ -1771,7 +1771,7 @@ good, skip, fatal, or unknown."
                                ange-ftp-gateway-program
                                ange-ftp-gateway-host)))
         (ftp (mapconcat 'identity args " ")))
-    (process-kill-without-query proc)
+    (set-process-query-on-exit-flag proc nil)
     (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
     (set-process-filter proc 'ange-ftp-gwp-filter)
     (save-excursion
@@ -1880,7 +1880,7 @@ been queued with no result.  CONT will still be called, however."
                    (start-process " *nslookup*" " *nslookup*"
                                   ange-ftp-nslookup-program host)))
            (res host))
-       (process-kill-without-query proc)
+       (set-process-query-on-exit-flag proc nil)
        (save-excursion
          (set-buffer (process-buffer proc))
          (while (memq (process-status proc) '(run open))
@@ -1918,7 +1918,8 @@ on the gateway machine to do the ftp instead."
     ;; but that doesn't work: ftp never responds.
     ;; Can anyone find a fix for that?
     (let ((process-connection-type t)
-         (process-environment process-environment)
+         ;; 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)
@@ -1937,7 +1938,7 @@ on the gateway machine to do the ftp instead."
       (set-buffer (process-buffer proc))
       (goto-char (point-max))
       (set-marker (process-mark proc) (point)))
-    (process-kill-without-query proc)
+    (set-process-query-on-exit-flag proc nil)
     (set-process-sentinel proc 'ange-ftp-process-sentinel)
     (set-process-filter proc 'ange-ftp-process-filter)
     ;; On Windows, the standard ftp client buffers its output (because
@@ -2918,11 +2919,8 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
               ;; error message.
               (gethash "." ent))
          ;; Child lookup failed, so try the parent.
-         (let ((table (ange-ftp-get-files dir 'no-error)))
-           ;; If the dir doesn't exist, don't use it as a hash table.
-           (and table
-                (ange-ftp-hash-entry-exists-p file
-                                              table)))))))
+         (ange-ftp-hash-entry-exists-p
+          file (ange-ftp-get-files dir 'no-error))))))
 
 (defun ange-ftp-get-file-entry (name)
   "Given NAME, return the given file entry.
@@ -3373,11 +3371,11 @@ system TYPE.")
   (setq file (ange-ftp-expand-file-name file))
   (if (ange-ftp-ftp-name file)
       (condition-case nil
-         (let ((file-ent
-                (gethash
-                 (ange-ftp-get-file-part file)
-                 (ange-ftp-get-files (file-name-directory file)))))
-           (and (stringp file-ent) file-ent))
+         (let ((ent (ange-ftp-get-files (file-name-directory file))))
+           (and ent
+                (stringp (setq ent
+                               (gethash (ange-ftp-get-file-part file) ent)))
+                ent))
        ;; If we can't read the parent directory, just assume
        ;; this file is not a symlink.
        ;; This makes it possible to access a directory that
@@ -3467,7 +3465,9 @@ system TYPE.")
                      inode             ;10 "inode number".
                      -1                ;11 device number [v19 only]
                      ))))
-      (ange-ftp-real-file-attributes file id-format))))
+      (if id-format
+         (ange-ftp-real-file-attributes file id-format)
+       (ange-ftp-real-file-attributes file)))))
 
 (defun ange-ftp-file-newer-than-file-p (f1 f2)
   (let ((f1-parsed (ange-ftp-ftp-name f1))
@@ -4113,6 +4113,9 @@ directory, so that Emacs will know its current contents."
                                       (format "Getting %s" fn1))
          tmp1))))
 
+(defun ange-ftp-file-remote-p (file)
+  (ange-ftp-replace-name-component file ""))
+
 (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
   (if (ange-ftp-ftp-name file)
       (let ((tryfiles (if nosuffix
@@ -4254,9 +4257,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
   (let ((fn (get operation 'ange-ftp)))
     (if fn (save-match-data (apply fn args))
       (ange-ftp-run-real-handler operation args))))
-;;;###autoload
-;;; These file names are remote file names.
-(put 'ange-ftp-hook-function 'file-remote-p t)
 
 ;; The following code is commented out because Tramp now deals with
 ;; Ange-FTP filenames, too.
@@ -4324,6 +4324,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
 (put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
 (put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
+(put 'file-remote-p 'ange-ftp 'ange-ftp-file-remote-p)
 (put 'unhandled-file-name-directory 'ange-ftp
      'ange-ftp-unhandled-file-name-directory)
 (put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
@@ -4513,9 +4514,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
               1))
     (apply 'call-process program nil (not discard) nil arguments)))
 
-(defvar ange-ftp-remote-shell "rsh"
-  "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
-
 ;; Handle an attempt to run chmod on a remote file
 ;; by using the ftp chmod command.
 (defun ange-ftp-call-chmod (args)
@@ -4540,7 +4538,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
                                                        abbr))))
                (or (car result)
                    (call-process
-                    ange-ftp-remote-shell
+                    remote-shell-program
                     nil t nil host dired-chmod-program mode name))))))
      rest))
   (setq ange-ftp-ls-cache-file nil)    ;Stop confusing Dired.