-;; -*-Emacs-Lisp-*-
-;;; ??? Waiting for papers from several people.
-;; Description: transparent FTP support for GNU Emacs
+;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;;; Copyright (C) 1989, 1990, 1991, 1992 Free Software Foundation, Inc.
+;;; Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;;; ??? Waiting for papers from several people.
;;;
-;;; Author: Andy Norman (ange@hplb.hpl.hp.com)
+;; Author: Andy Norman (ange@hplb.hpl.hp.com)
+;; Keywords: comm
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 1, or (at your option)
+;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
-;;; Description:
+;;; Commentary:
;;;
;;; This package attempts to make accessing files and directories using FTP
;;; from within GNU Emacs as simple and transparent as possible. A subset of
;;; whose names I've forgotten who have helped to debug and fix problems with
;;; ange-ftp.el.
\f
+
+;;; Code:
(require 'comint)
;;;; ------------------------------------------------------------
process uses the \'dir\' command to get directory information.")
(defvar ange-ftp-binary-file-name-regexp
- (concat "\\.Z$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
+ (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
"\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
- "\\.EXE\\(;[0-9]+\\)?$\\|\\.Z-part-..$")
+ "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$")
"*If a file matches this regexp then it is transferred in binary mode.")
(defvar ange-ftp-gateway-host nil
(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
;;;; Internal variables.
;;;; ------------------------------------------------------------
-(defconst ange-ftp-version "$Revision: 4.20 $")
+(defconst ange-ftp-version "$Revision: 1.18 $")
(defvar ange-ftp-data-buffer-name " *ftp data*"
"Buffer name to hold directory listing data received from ftp process.")
(if (> (length pass) 0)
(setq pass (substring pass 0 -1))))))
(message "")
-;; (ange-ftp-repaint-minibuffer)
+ (ange-ftp-repaint-minibuffer)
pass))
(defmacro ange-ftp-generate-passwd-key (host user)
;;;; ------------------------------------------------------------
(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
(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
;; (setq ange-ftp-tmp-keymap (make-sparse-keymap))
;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
-;; (defun ange-ftp-repaint-minibuffer ()
-;; "Gross hack to set minibuf_message = 0, so that the contents of the
-;; minibuffer will show."
-;; (if (eq (selected-window) (minibuffer-window))
-;; (if (fboundp 'allocate-event)
-;; ;; lemacs
-;; (let ((unread-command-event (character-to-event ?\C-m
-;; (allocate-event)))
-;; (enable-recursive-minibuffers t))
-;; (read-from-minibuffer "" nil ange-ftp-tmp-keymap nil))
-;; ;; v18 GNU Emacs
-;; (let ((unread-command-char ?\C-m)
-;; (enable-recursive-minibuffers t))
-;; (read-from-minibuffer "" nil ange-ftp-tmp-keymap nil)))))
+(defun ange-ftp-repaint-minibuffer ()
+ "Clear any existing minibuffer message; let the minibuffer contents show."
+ (message nil))
(defun ange-ftp-ftp-process-buffer (host user)
"Return the name of the buffer that collects output from the ftp process
(signal 'ftp-error (list (format "FTP Error: %s" msg))))
(defun ange-ftp-set-buffer-mode ()
- "Set the correct modes for the current buffer if it is visiting a remote
-file."
- (make-local-variable 'make-backup-files)
- (setq make-backup-files ange-ftp-make-backup-files)
+ "Set correct modes for the current buffer if visiting a remote file."
(if (and (stringp buffer-file-name)
(ange-ftp-ftp-name buffer-file-name))
(progn
+ (make-local-variable 'make-backup-files)
+ (setq make-backup-files ange-ftp-make-backup-files)
(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)
ange-ftp-process-result)
(progn
(ange-ftp-message "%s...done" ange-ftp-process-msg)
-;; (ange-ftp-repaint-minibuffer)
+ (ange-ftp-repaint-minibuffer)
(setq ange-ftp-process-msg nil)))
;; is there a continuation we should be calling? if so,
(save-excursion
(set-buffer (process-buffer proc))
(while ange-ftp-process-busy
- (accept-process-output))
+ ;; This is a kludge to let user quit in case ftp gets hung.
+ ;; It matters because this function can be called from the filter.
+ ;; It is bad to allow quitting in a filter, but getting hung
+ ;; is worse. By binding quit-flag to nil, we might avoid
+ ;; most of the probability of getting screwed because the user
+ ;; wants to quit some command.
+ (let ((quit-flag nil)
+ (inhibit-quit nil))
+ (accept-process-output)))
(setq ange-ftp-process-string ""
ange-ftp-process-result-line ""
ange-ftp-process-busy t
nil
;; hang around for command to complete
(while ange-ftp-process-busy
- (accept-process-output proc))
+ ;; This is a kludge to let user quit in case ftp gets hung.
+ ;; It matters because this function can be called from the filter.
+ (let ((quit-flag nil)
+ (inhibit-quit nil))
+ (accept-process-output proc)))
(if cont
nil ;cont has already been called
(cons ange-ftp-process-result ange-ftp-process-result-line))))))
"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
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
(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))
(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))
(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)))
(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)))
(format "Getting %s" fn1))
tmp1))))
\f
+;; Calculate default-unhandled-directory for a given ange-ftp buffer.
+(defun ange-ftp-unhandled-file-name-directory (filename)
+ (file-name-directory ange-ftp-tmp-name-template))
+
+\f
;; Need the following functions for making filenames of compressed
;; files, because some OS's (unlike UNIX) do not allow a filename to
;; have two extensions.
(ange-ftp-compress name newfile)
(ange-ftp-uncompress name newfile)))
(let (file-name-handler-alist)
- (dired-compress-filename name)))))
+ (dired-compress-file name)))))
;; Copy FILE to this machine, compress it, and copy out to NFILE.
(defun ange-ftp-compress (file nfile)
(apply operation args)))))
;;;###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)))
;;; The above two forms are sufficient to cause this file to be loaded
(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 '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)
(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.
"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
"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
"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
;;;; ------------------------------------------------------------
(provide 'ange-ftp)
+
+;;; ange-ftp.el ends here
HCoop / bpt / emacs.git / blobdiff