]> code.delx.au - gnu-emacs/blobdiff - lisp/ange-ftp.el
(shell-command-on-region):
[gnu-emacs] / lisp / ange-ftp.el
index ba0b2a40016f6cf06db460f608dcbca377b97eec..6e771fa214be5f1880dac3e7d9f58c91441a37f0 100644 (file)
@@ -849,7 +849,7 @@ SIZE, if supplied, should be a prime number."
   (intern-soft (ange-ftp-make-hash-key key) tbl))
 
 (defun ange-ftp-hash-table-keys (tbl)
-  "Return a sorted list of all the active keys in the hashtable, as strings."
+  "Return a sorted list of all the active keys in TABLE, as strings."
   (sort (all-completions "" tbl)
        (function string-lessp)))
 \f
@@ -857,7 +857,7 @@ SIZE, if supplied, should be a prime number."
 ;;;; Internal variables.
 ;;;; ------------------------------------------------------------
 
-(defconst ange-ftp-version "$Revision: 4.20 $")
+(defconst ange-ftp-version "$Revision: 1.9 $")
 
 (defvar ange-ftp-data-buffer-name " *ftp data*"
   "Buffer name to hold directory listing data received from ftp process.")
@@ -1131,7 +1131,7 @@ Optional DEFAULT is password to start with."
 ;;;; ------------------------------------------------------------
 
 (defun ange-ftp-chase-symlinks (file)
-  "Return the filename that FILENAME references, following all symbolic links."
+  "Return the filename that FILE references, following all symbolic links."
   (let (temp)
     (while (setq temp (ange-ftp-real-file-symlink-p file))
       (setq file
@@ -1194,7 +1194,8 @@ found."
     (goto-char end)))
 
 (defun ange-ftp-parse-netrc ()
-  "If ~/.netrc file exists and has the correct permissions then extract the
+  "Read in ~/.netrc, if one exists.
+If ~/.netrc file exists and has the correct permissions then extract the
 \`machine\', \`login\', \`password\' and \`account\' information from within."
 
   ;; We set this before actually doing it to avoid the possibility
@@ -1344,7 +1345,8 @@ file."
        (auto-save-mode ange-ftp-auto-save))))
 
 (defun ange-ftp-kill-ftp-process (buffer)
-  "If the BUFFER's visited filename or default-directory is an ftp filename
+  "Kill the FTP process associated with BUFFER.
+If the BUFFER's visited filename or default-directory is an ftp filename
 then kill the related ftp process."
   (interactive "bKill FTP process associated with buffer: ")
   (if (null buffer)
@@ -2169,9 +2171,7 @@ to take switch arguments."
   "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp."
   (interactive
    (list (read-string "Host: "
-                     (let ((name (or (buffer-file-name)
-                                     (and (eq major-mode 'dired-mode)
-                                          dired-directory))))
+                     (let ((name (or (buffer-file-name) default-directory)))
                        (and name (car (ange-ftp-ftp-name name)))))))
   (if (not (ange-ftp-dumb-unix-host host))
       (setq ange-ftp-dumb-unix-host-regexp
@@ -2399,12 +2399,10 @@ shouldn't be anchored with a trailing $ so that it will match subdirectories
 as well.")
 
 (defun ange-ftp-add-dl-dir (dir)
-  "Interactively adds a given directory to ange-ftp-dl-dir-regexp."
+  "Interactively adds a DIR to ange-ftp-dl-dir-regexp."
   (interactive
    (list (read-string "Directory: "
-                     (let ((name (or (buffer-file-name)
-                                     (and (eq major-mode 'dired-mode)
-                                          dired-directory))))
+                     (let ((name (or (buffer-file-name) default-directory)))
                        (and name (ange-ftp-ftp-name name)
                             (file-name-directory name))))))
   (if (not (and ange-ftp-dl-dir-regexp
@@ -2529,10 +2527,11 @@ that a wasted listing is not done:
             (host-type (ange-ftp-host-type
                         (car parsed))))
        (or
-        ;; Deal with dired
-        (and (boundp 'dired-local-variables-file)
-             (stringp dired-local-variables-file)
-             (string-equal dired-local-variables-file efile))
+;;; This variable seems not to exist in Emacs 19 -- rms.
+;;;     ;; Deal with dired
+;;;     (and (boundp 'dired-local-variables-file)
+;;;          (stringp dired-local-variables-file)
+;;;          (string-equal dired-local-variables-file efile))
         ;; No dots in dir names in vms.
         (and (eq host-type 'vms)
              (string-match "\\." efile))
@@ -2567,9 +2566,10 @@ that a wasted listing is not done:
                                        (ange-ftp-get-files dir))))))
 
 (defun ange-ftp-get-file-entry (name)
-  "Given NAME, return the given file entry which will be either t for a
-directory, nil for a normal file, or a string for a symlink. If the file
-isn't in the hashtable, this also returns nil."
+  "Given NAME, return the given file entry.
+The entry will be either t for a directory, nil for a normal file,
+or a string for a symlink. If the file isn't in the hashtable,
+this also returns nil."
   (let* ((name (directory-file-name name))
         (dir (file-name-directory name))
         (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
@@ -3381,7 +3381,7 @@ system TYPE.")
       (delete-file filename))))
 
 (defun ange-ftp-rename-local-to-remote (filename newname)
-  "Rename local FILE to remote file NEWNAME."
+  "Rename local FILENAME to remote file NEWNAME."
   (let* ((fabbr (ange-ftp-abbreviate-filename filename))
         (nabbr (ange-ftp-abbreviate-filename newname filename))
         (msg (format "Renaming %s to %s" fabbr nabbr)))
@@ -3390,7 +3390,7 @@ system TYPE.")
       (delete-file filename))))
 
 (defun ange-ftp-rename-remote-to-local (filename newname)
-  "Rename remote file FILE to local file NEWNAME."
+  "Rename remote file FILENAME to local file NEWNAME."
   (let* ((fabbr (ange-ftp-abbreviate-filename filename))
         (nabbr (ange-ftp-abbreviate-filename newname filename))
         (msg (format "Renaming %s to %s" fabbr nabbr)))
@@ -3777,6 +3777,14 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
 (put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
 (put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
+
+;; Turn off truename processing to save time.
+;; Treat each name as its own truename.
+(put 'file-truename 'ange-ftp 'identity)
+
+;; Turn off RCS/SCCS processing to save time.
+;; This returns nil for any file name as argument.
+(put 'vc-registered 'ange-ftp 'null)
 \f
 ;;; Define ways of getting at unmodified Emacs primitives,
 ;;; turning off our handler.
@@ -4564,9 +4572,7 @@ Other orders of $ and _ seem to all work just fine.")
   "Mark HOST as the name of a machine running VMS."
   (interactive
    (list (read-string "Host: "
-                     (let ((name (or (buffer-file-name)
-                                     (and (eq major-mode 'dired-mode)
-                                          dired-directory))))
+                     (let ((name (or (buffer-file-name) default-directory)))
                        (and name (car (ange-ftp-ftp-name name)))))))
   (if (not (ange-ftp-vms-host host))
       (setq ange-ftp-vms-host-regexp
@@ -4974,9 +4980,7 @@ Other orders of $ and _ seem to all work just fine.")
   "Mark HOST as the name of a machine running MTS."
   (interactive
    (list (read-string "Host: "
-                     (let ((name (or (buffer-file-name)
-                                     (and (eq major-mode 'dired-mode)
-                                          dired-directory))))
+                     (let ((name (or (buffer-file-name) default-directory)))
                        (and name (car (ange-ftp-ftp-name name)))))))
   (if (not (ange-ftp-mts-host host))
       (setq ange-ftp-mts-host-regexp
@@ -5158,9 +5162,7 @@ Other orders of $ and _ seem to all work just fine.")
   "Mark HOST as the name of a CMS host."
   (interactive
    (list (read-string "Host: "
-                     (let ((name (or (buffer-file-name)
-                                     (and (eq major-mode 'dired-mode)
-                                          dired-directory))))
+                     (let ((name (or (buffer-file-name) default-directory)))
                        (and name (car (ange-ftp-ftp-name name)))))))
   (if (not (ange-ftp-cms-host host))
       (setq ange-ftp-cms-host-regexp