home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1924 < prev    next >
Encoding:
Text File  |  1990-12-28  |  50.8 KB  |  1,368 lines
  1. Newsgroups: alt.sources
  2. From: ange@HPLB.HPL.HP.COM (Andy Norman)
  3. Subject: [gnu.emacs] 'ange-ftp' -- ftp support for GNU Emacs
  4. Message-ID: <1990Oct8.144723.10459@math.lsa.umich.edu>
  5. Date: Mon, 8 Oct 90 14:47:23 GMT
  6.  
  7. Archive-name: ange-ftp/08-Oct-90
  8. Original-posting-by: ange@HPLB.HPL.HP.COM (Andy Norman)
  9. Original-subject: 'ange-ftp' -- ftp support for GNU Emacs
  10. Reposted-by: emv@math.lsa.umich.edu (Edward Vielmetti)
  11.  
  12. [Reposted from gnu.emacs.
  13. Comments on this service to emv@math.lsa.umich.edu (Edward Vielmetti).]
  14.  
  15. Some time ago I posted 'ange-ftp.el' -- a package which extended many of GNU
  16. Emacs' file-handling routines to cope with (Unix) files and directories
  17. available via ftp.
  18.  
  19. At the end of this posting I include the latest version of ange-ftp.el.  To
  20. use, just byte-compile then load.  Once loaded, filenames that look like:
  21.  
  22.   /user@host:/path
  23.  
  24. will be handled by ange-ftp as an ftp connection to machine 'host', logged in
  25. as user 'user' and dealing with pathname 'path'.  The 'user@' can be omitted
  26. and a suitable default generated.
  27.  
  28. If the machine running GNU Emacs can't ftp, or can only ftp to a restricted
  29. number of hosts, then a 'gateway' machine may be used instead as long as there
  30. is a shared filesystem between the 2 machines.
  31.  
  32. If there are any problems, please e-mail me directly.
  33.  
  34. Enjoy...
  35.  
  36.                     -- ange --
  37.  
  38.                     ange@hplb.hpl.hp.com
  39. --------------------------------------------------------------------------------
  40. ;; -*-Emacs-Lisp-*-
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ;;
  43. ;; File:         ange-ftp.el
  44. ;; RCS:          $Header: ange-ftp.el,v 3.31 90/10/08 10:18:15 ange Exp $
  45. ;; Description:  simple ftp access to files from GNU Emacs
  46. ;; Author:       Andy Norman, ange@hplb.hpl.hp.com
  47. ;; Created:      Thu Oct 12 14:00:05 1989
  48. ;; Modified:     Mon Oct  8 10:16:29 1990 (Ange) ange@anorman
  49. ;;
  50. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51.  
  52. ;;; Copyright (C) 1990 Andy Norman.
  53. ;;;
  54. ;;; Author: Andy Norman (ange@hplb.hpl.hp.com)
  55. ;;;
  56. ;;; This program is free software; you can redistribute it and/or modify
  57. ;;; it under the terms of the GNU General Public License as published by
  58. ;;; the Free Software Foundation; either version 1, or (at your option)
  59. ;;; any later version.
  60. ;;;
  61. ;;; This program is distributed in the hope that it will be useful,
  62. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  63. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  64. ;;; GNU General Public License for more details.
  65. ;;;
  66. ;;; A copy of the GNU General Public License can be obtained from this
  67. ;;; program's author (send electronic mail to ange@hplb.hpl.hp.com) or from
  68. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  69. ;;; 02139, USA.
  70.  
  71. ;;; This package attempts to make accessing files / directories using ftp from
  72. ;;; within GNU Emacs as simple as possible.  A subset of the normal
  73. ;;; file-handling routines are extended to understand ftp.
  74. ;;;
  75. ;;; To read or write a file using ftp, or to read a directory using ftp, the
  76. ;;; only thing that a user needs to do is to specify the filename using a 
  77. ;;; slighly extended syntax.
  78. ;;;
  79. ;;; The default syntax of ftp files is /user@host:path.  This is customizable.
  80. ;;; See the variable ange-ftp-path-format for more details.
  81. ;;;
  82. ;;; A password is required for each host/user pair.  This will be prompted for
  83. ;;; when needed, unless already set by calling ange-ftp-set-passwd, or
  84. ;;; specified in a valid ~/.netrc file.
  85. ;;;
  86. ;;; Ftp processes are left running for speed.  They can easily be killed by
  87. ;;; killing their associated buffers.
  88. ;;;
  89. ;;; Full file name completion is supported on remote files.
  90. ;;;
  91. ;;; File transfers can be done in binary mode. See the documentation for the
  92. ;;; variable ange-ftp-binary-file-name-regexp for more details.
  93. ;;;
  94. ;;; The ftp process can be either be run locally, or run on a different machine.
  95. ;;; Sometimes this is neccessary when the local machine does not have full internet
  96. ;;; access.  See the documentation for the variables ange-ftp-gateway-host,
  97. ;;; ange-ftp-local-host-regexp, ange-ftp-gateway-tmp-name-template, 
  98. ;;; ange-ftp-gateway-program and ange-ftp-gateway-program-interactive for more
  99. ;;; details.
  100. ;;;
  101. ;;; WARNING, the following GNU Emacs functions are replaced by this program:
  102. ;;;
  103. ;;;   write-region
  104. ;;;   insert-file-contents
  105. ;;;   dired-readin
  106. ;;;   delete-file
  107. ;;;   read-file-name-internal
  108. ;;;   verify-visited-file-modtime
  109. ;;;   directory-files
  110. ;;;   backup-buffer
  111. ;;;   file-directory-p
  112. ;;;   file-writable-p
  113. ;;;   file-exists-p
  114. ;;;   file-readable-p
  115. ;;;   file-attributes
  116. ;;;   copy-file
  117. ;;;
  118. ;;; If you find any bugs or problems with this package, please e-mail the above
  119. ;;; author.  Constructive comments are especially welcome.
  120. ;;;
  121. ;;; Many thanks to Roland McGrath <roland@ai.mit.edu> for improving the filename
  122. ;;; syntax handling, for suggesting many enhancements and for numerous cleanups
  123. ;;; to the code.
  124. ;;;
  125. ;;; Thanks also to Jamie Zawinski <jwz@lucid.com> for bugfixes and for ideas
  126. ;;; such as gateways.
  127. ;;;
  128.  
  129. ;;;; ------------------------------------------------------------
  130. ;;;; User customization variables.
  131. ;;;; ------------------------------------------------------------
  132.  
  133. (defvar ange-ftp-path-format
  134.   '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" . (3 2 4))
  135.   "*Format of a fully expanded remote pathname.  This is a cons
  136. \(REGEXP . \(HOST USER PATH\)\), where REGEXP is a regular expression matching
  137. the full remote pathname, and HOST, USER, and PATH are the numbers of
  138. parenthesized expressions in REGEXP for the components (in that order).")
  139.  
  140. (defvar ange-ftp-good-msgs
  141.   "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 "
  142.   "*Regular expression matching messages from the ftp process that indicate
  143. that the action that was initiated has completed successfully.")
  144.  
  145. (defvar ange-ftp-skip-msgs
  146.   (concat "^200 PORT \\|^331 \\|^2.0-\\|^150 \\|^[0-9]+ bytes \\|"
  147.       "^Connected \\|^$\\|^Remote system\\|^Using\\|^ ")
  148.   "*Regular expression matching messages from the ftp process that can be
  149. ignored.")
  150.  
  151. (defvar ange-ftp-fatal-msgs "^ftp: \\|^Not connected\\|^530 \\|^421 \\|rcmd: "
  152.   "*Regular expression matching messages from the ftp process that indicate
  153. something has gone drastically wrong attempting the action that was
  154. initiated.")
  155.  
  156. (defvar ange-ftp-ls-follow-symbolic-links t
  157.   "*If non-nil, tell ls to always follow symbolic links.")
  158.  
  159. (defvar ange-ftp-tmp-name-template "/tmp/ange-ftp"
  160.   "*Template given to make-temp-name to create temporary files.")
  161.  
  162. (defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
  163.   "*Template given to make-temp-name to create temporary files when
  164. ftp-ing through a gateway.  Files starting with this prefix need to
  165. be accessible from BOTH the local machine and the gateway machine, 
  166. and need to have the SAME name on both machines, that is, /tmp is probably
  167. NOT what you want, since that is rarely cross-mounted.")
  168.  
  169. (defvar ange-ftp-copy-tmp-name-template "/tmp/ange-ftp-copy"
  170.   "*Template given to make-temp-name to to create temporary files when
  171. copying files between one remote machine and another.
  172. This should be different from \`ange-ftp-tmp-name-template\' and
  173. \'ange-ftp-gateway-tmp-name-template\'.")
  174.  
  175. (defvar ange-ftp-netrc-filename "~/.netrc"
  176.   "*File in .netrc format to search for passwords.")
  177.  
  178. (defvar ange-ftp-default-user nil
  179.   "*User name to use when none is specied in a pathname.
  180. If nil, then the name under which the user is logged in is used.
  181. If non-nil but not a string, the user is prompted for the name.")
  182.  
  183. (defvar ange-ftp-generate-anonymous-password nil
  184.   "*If non-nil, by default use a password of user@host when logging
  185. in as the anonymous user.")
  186.  
  187. (defvar ange-ftp-dumb-host-regexp nil
  188.   "*If non-nil, if the host being ftp'd to matches this regexp then the ftp
  189. process uses the \'dir\' command to get directory information.")
  190.  
  191. (defvar ange-ftp-binary-file-name-regexp
  192.   "\\.Z$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|\\.dvi$\\|\\.ps$"
  193.   "*If a file matches this regexp then it is transferred in binary mode.")
  194.  
  195. (defvar ange-ftp-gateway-host nil
  196.   "*Name of host to use as gateway machine when local ftp isn't possible.")
  197.  
  198. (defvar ange-ftp-local-host-regexp ".*"
  199.   "*If a host being ftp'd to matches this regexp then the ftp process is started
  200. locally, otherwise the ftp process is started on \`ange-ftp-gateway-host\'
  201. instead.")
  202.  
  203. (defvar ange-ftp-gateway-program-interactive nil
  204.   "*If non-nil then the gateway program is expected to connect to the gateway
  205. machine and eventually give a shell prompt.  Both telnet and rlogin do something
  206. like this.")
  207.  
  208. (defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
  209.   "*Name of program to spawn a shell on the gateway machine.  Valid candidates
  210. are remsh (rsh on hp-ux), telnet and rlogin.  See also the gateway variable
  211. above.")
  212.  
  213. (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *"
  214.   "*Regexp used to detect that the logging-in sequence is completed on the
  215. gateway machine and that the shell is now awaiting input.")
  216.  
  217. (defvar ange-ftp-gateway-setup-term-command "stty -onlcr -echo\n"
  218.   "*Command to use after logging in to the gateway machine to stop the terminal
  219. echoing each command and to strip out trailing ^M characters.")
  220.  
  221. ;;;; ------------------------------------------------------------
  222. ;;;; Hash table support.
  223. ;;;; ------------------------------------------------------------
  224.  
  225. (defun ange-ftp-make-hashtable (&optional size)
  226.   "Make an obarray suitable for use as a hashtable.
  227. SIZE, if supplied, should be a prime number."
  228.   (make-vector (or size 511) 0))
  229.  
  230. (defun ange-ftp-map-hashtable (fun tbl)
  231.   "Call FUNCTION on each key in HASHTABLE."
  232.   (mapatoms
  233.    (function 
  234.     (lambda (sym)
  235.       (and (get sym 'active)
  236.        (funcall fun (get sym 'key)))))
  237.    tbl))
  238.  
  239. (defmacro ange-ftp-make-hash-key (key)
  240.   "Convert KEY into a suitable key for a hashtable."
  241.   (` (if (stringp (, key))
  242.      (, key)
  243.        (prin1-to-string (, key)))))
  244.  
  245. (defun ange-ftp-get-hash-entry (key tbl)
  246.   "Return the value associated with KEY in HASHTABLE."
  247.   (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
  248.     (and sym
  249.      (get sym 'active)
  250.      (get sym 'val))))
  251.  
  252. (defun ange-ftp-put-hash-entry (key val tbl)
  253.   "Record an association between KEY and VALUE in HASHTABLE."
  254.   (let ((sym (intern (ange-ftp-make-hash-key key) tbl)))
  255.     (put sym 'val val)
  256.     (put sym 'key key)
  257.     (put sym 'active t)))
  258.  
  259. (defun ange-ftp-del-hash-entry (key tbl)
  260.   "Delete KEY from HASHTABLE."
  261.   (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
  262.     (and sym (put sym 'active nil))))
  263.  
  264. (defun ange-ftp-hash-entry-exists-p (key tbl)
  265.   "Return whether there is an association for KEY in TABLE."
  266.   (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
  267.     (and sym (get sym 'active))))
  268.  
  269. (defun ange-ftp-hash-table-keys (tbl)
  270.   "Return a sorted list of all the active keys in the hashtable, as strings."
  271.   (sort (all-completions ""
  272.              tbl
  273.              (function (lambda (x) (get x 'active))))
  274.     (function string-lessp)))
  275.  
  276. ;;;; ------------------------------------------------------------
  277. ;;;; Internal variables.
  278. ;;;; ------------------------------------------------------------
  279.  
  280. (defvar ange-ftp-data-buffer-name "*ftp data*"
  281.   "Buffer name to hold data received from ftp process.")
  282.  
  283. (defvar ange-ftp-process-string ""
  284.   "Currently unprocessed output from the ftp process.")
  285.  
  286. (defvar ange-ftp-process-running nil
  287.   "Boolean indicates whether the ftp process is currently handling
  288. an action.")
  289.  
  290. (defvar ange-ftp-process-status nil
  291.   "Set to t if an action sent to the ftp process succeeds.")
  292.  
  293. (defvar ange-ftp-have-read-netrc nil
  294.   "Boolean indicating whether the user's .netrc file has been read yet.")
  295.  
  296. (defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable)
  297.   "Hash table holding associations between HOST, USER pairs.")
  298.  
  299. (defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
  300.   "Mapping between a HOST, USER pair and a PASSWORD for it.")
  301.  
  302. (defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable)
  303.   "Hash table for storing directories and their respective files.")
  304.  
  305. ;;;; ------------------------------------------------------------
  306. ;;;; Password support.
  307. ;;;; ------------------------------------------------------------
  308.  
  309. (defun ange-ftp-read-passwd (prompt)
  310.   "Read a password from the user. Echos a . for each character typed.
  311. End with RET, LFD, or ESC. DEL or C-h rubs out."
  312.   (let ((pass "")
  313.     (c 0)
  314.     (echo-keystrokes 0)
  315.     (cursor-in-echo-area t))
  316.     (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
  317.       (message "%s%s"
  318.            prompt
  319.            (make-string (length pass) ?.))
  320.       (setq c (read-char))
  321.       (if (and (/= c ?\b) (/= c ?\177))
  322.       (setq pass (concat pass (char-to-string c)))
  323.     (if (> (length pass) 0)
  324.         (setq pass (substring pass 0 -1)))))
  325.     (substring pass 0 -1)))
  326.  
  327. (defun ange-ftp-set-user (host user)
  328.   "For a given HOST, set or change the default USER."
  329.   (interactive "sHost: \nsUser: ")
  330.   (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable))
  331.  
  332. (defun ange-ftp-get-user (host)
  333.   "Given a HOST, return the default USER."
  334.   (or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
  335.   (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable)))
  336.     (or user
  337.     (cond ((stringp ange-ftp-default-user)
  338.            ;; We have a default name.  Use it.
  339.            ange-ftp-default-user)
  340.           (ange-ftp-default-user
  341.            ;; Ask the user and remember the response.
  342.            (let ((user (read-string (format "User for %s: " host)
  343.                     (user-login-name))))
  344.          (ange-ftp-set-user host user)
  345.          user))
  346.           ;; Default to the user's login name.
  347.           (t (user-login-name))))))
  348.  
  349. (defun ange-ftp-set-passwd (host user passwd)
  350.   "For a given HOST and USER, set or change the associated PASSWD."
  351.   (interactive (list (read-string "Host: ")
  352.              (read-string "User: ")
  353.              (ange-ftp-read-passwd "Password: ")))
  354.   (ange-ftp-put-hash-entry (concat host "/" user)
  355.                passwd
  356.                ange-ftp-passwd-hashtable))
  357.  
  358. (defun ange-ftp-get-passwd (host user)
  359.   "Given a HOST and USER, return the ftp password,
  360. prompting if it was not previously set."
  361.   (or ange-ftp-have-read-netrc (ange-ftp-parse-netrc))
  362.   (let ((passwd (ange-ftp-get-hash-entry (concat host "/" user)
  363.                      ange-ftp-passwd-hashtable)))
  364.     (or passwd
  365.     (and ange-ftp-generate-anonymous-password
  366.          (string-equal user "anonymous")
  367.          (concat (user-login-name) "@" (system-name)))
  368.     (let ((passwd (ange-ftp-read-passwd
  369.                (format "Password for %s@%s: " user host))))
  370.       (ange-ftp-set-passwd host user passwd)
  371.       passwd))))
  372.  
  373. ;;;; ------------------------------------------------------------
  374. ;;;; ~/.netrc support
  375. ;;;; ------------------------------------------------------------
  376.  
  377. (defun ange-ftp-parse-field (field limit)
  378.   "Move along current line looking for the value of the FIELD.  Valid
  379. separators between FIELD and its value are commas and whitespace.
  380. Second arg LIMIT is a limit for the search."
  381.   (if (search-forward field limit t)
  382.       (let (beg)
  383.     (skip-chars-forward ", \t" limit)
  384.     (if (looking-at "\"")        ;quoted field value
  385.         (progn (forward-char 1)
  386.            (setq beg (point))
  387.            (skip-chars-forward "^\"" limit)
  388.            (forward-char 1)
  389.            (buffer-substring beg (1- (point))))
  390.       (setq beg (point))
  391.       (skip-chars-forward "^, \t" limit)
  392.       (buffer-substring beg (point))))))
  393.  
  394. (defun ange-ftp-parse-line ()
  395.   "Extract the values of the fields \`machine\', \`login\' and \`password\'
  396. from the current line of the buffer.  If successful, call ange-ftp-set-passwd
  397. with the values found."
  398.   (let ((eol (progn (end-of-line) (point)))
  399.     machine login password)
  400.     (beginning-of-line)
  401.     (setq machine (ange-ftp-parse-field "machine" eol)
  402.       login (ange-ftp-parse-field "login" eol)
  403.       password (ange-ftp-parse-field "password" eol))
  404.     (and machine login
  405.      (progn
  406.        (ange-ftp-set-user machine login)
  407.        (ange-ftp-set-passwd machine login password)))))
  408.  
  409. (defun ange-ftp-parse-netrc ()
  410.   "If ~/.netrc file exists and has the correct security then extract the
  411. \`machine\', \`login\' and \`password\' information from each line." 
  412.   ;; We set this before actually doing it to avoid the possibility
  413.   ;; of an infinite loop if ange-ftp-netrc-filename is an ftp file.
  414.   (setq ange-ftp-have-read-netrc t)
  415.   (let* ((file (expand-file-name ange-ftp-netrc-filename))
  416.      (attr (file-attributes file)))
  417.     (if attr                ; File exits.
  418.     (if (and (eq (nth 2 attr) (user-uid)) ; Same uids.
  419.          (string-match ".r..------" (nth 8 attr))) ; Readable by user only.
  420.         (progn
  421.           (set-buffer (generate-new-buffer "*ftp-.netrc*"))
  422.           (insert-file-contents file)
  423.           (goto-char (point-min))
  424.           (while (not (eobp))
  425.         (ange-ftp-parse-line)
  426.         (forward-line 1))
  427.           (kill-buffer (current-buffer)))
  428.       (message "skipping badly configured .netrc file")))))
  429.  
  430. ;;;; ------------------------------------------------------------
  431. ;;;; Miscellaneous utils.
  432. ;;;; ------------------------------------------------------------
  433.  
  434. (defun ange-ftp-ftp-process-buffer (host user)
  435.   "Return the name of the buffer that collects output from the ftp process
  436. connected to the given HOST and USER pair."
  437.   (concat "*ftp " user "@" host "*"))
  438.  
  439. (defun ange-ftp-error (host user msg)
  440.   "Display the last chunk of output from the ftp process for the given HOST
  441. USER pair, and signal an error including MSG in the text."
  442.   (let ((cur (selected-window))
  443.     (pop-up-windows t))
  444.     (pop-to-buffer
  445.      (get-buffer-create
  446.       (ange-ftp-ftp-process-buffer host user)))
  447.     (goto-char (point-max))
  448.     (select-window cur))
  449.   (error "ange-ftp: %s" msg))
  450.  
  451. (defun ange-ftp-set-buffer-mode ()
  452.   "Set the correct modes for the current buffer if it is visiting a remote
  453. file."
  454.   (if (ange-ftp-ftp-path buffer-file-name)
  455.       (progn
  456.     (auto-save-mode 0)
  457.     (make-variable-buffer-local 'revert-buffer-function)
  458.     (setq revert-buffer-function 'ange-ftp-revert-buffer))))
  459.  
  460. (defun ange-ftp-kill-ftp-process (buffer)
  461.   "If the BUFFER's visited filename or default-directory is an ftp filename
  462. then kill the related ftp process."
  463.   (interactive "bKill FTP process associated with buffer: ")
  464.   (if (null buffer)
  465.       (setq buffer (current-buffer)))
  466.   (let ((file (or (buffer-file-name) default-directory)))
  467.     (if file
  468.     (let ((parsed (ange-ftp-ftp-path (expand-file-name file))))
  469.       (if parsed
  470.           (let ((host (nth 0 parsed))
  471.             (user (nth 1 parsed)))
  472.         (kill-buffer (ange-ftp-ftp-process-buffer host user))))))))
  473.  
  474.  
  475. ;;;; ------------------------------------------------------------
  476. ;;;; FTP process filter support.
  477. ;;;; ------------------------------------------------------------
  478.  
  479. (defun ange-ftp-process-handle-line (line)
  480.   "Look at the given LINE from the ftp process.  Try to catagorize it
  481. into one of four categories: good, skip, fatal, or unknown."
  482.   (cond ((string-match ange-ftp-skip-msgs line)
  483.      t)
  484.     ((string-match ange-ftp-good-msgs line)
  485.      (setq ange-ftp-process-running nil
  486.            ange-ftp-process-status t))
  487.     ((string-match ange-ftp-fatal-msgs line)
  488.      (delete-process proc)
  489.      (setq ange-ftp-process-running nil))
  490.     (t
  491.      (setq ange-ftp-process-running nil))))
  492.  
  493. (defun ange-ftp-process-log-string (proc str)
  494.   "For a given PROCESS, log the given STRING at the end of its
  495. associated buffer."
  496.   (save-excursion
  497.     (set-buffer (process-buffer proc))
  498.     (goto-char (point-max))
  499.     (insert str)))
  500.  
  501. (defun ange-ftp-process-filter (proc str)
  502.   "Build up a complete line of output from the ftp PROCESS and pass it
  503. on to ange-ftp-process-handle-line to deal with."
  504.   (setq ange-ftp-process-string (concat ange-ftp-process-string str))
  505.   (ange-ftp-process-log-string proc str)
  506.   (while (and ange-ftp-process-running
  507.           (string-match "\n" ange-ftp-process-string))
  508.     (let ((line (substring ange-ftp-process-string 0 (match-beginning 0))))
  509.       (setq ange-ftp-process-string (substring ange-ftp-process-string
  510.                            (match-end 0)))
  511.       (while (string-match "^ftp> " line)
  512.     (setq line (substring line (match-end 0))))
  513.       (ange-ftp-process-handle-line line))))
  514.  
  515. (defun ange-ftp-process-sentinel (proc str)
  516.   "When ftp process changes state, nuke all file-entries in cache."
  517.   (let ((name (process-name proc)))
  518.     (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name)
  519.       (let ((user (substring name (match-beginning 1) (match-end 1)))
  520.         (host (substring name (match-beginning 2) (match-end 2))))
  521.     (ange-ftp-wipe-file-entries host user)))))
  522.  
  523. ;;;; ------------------------------------------------------------
  524. ;;;; Gateway support.
  525. ;;;; ------------------------------------------------------------
  526.  
  527. (defun ange-ftp-use-gateway-p (host)
  528.   (not (string-match ange-ftp-local-host-regexp host)))
  529.  
  530. (defun ange-ftp-make-tmp-name (host)
  531.   (make-temp-name (if (ange-ftp-use-gateway-p host)
  532.               ange-ftp-gateway-tmp-name-template
  533.             ange-ftp-tmp-name-template)))
  534.  
  535.  
  536. ;;;; ------------------------------------------------------------
  537. ;;;; Interactive gateway program support.
  538. ;;;; ------------------------------------------------------------
  539.  
  540. (defvar ange-ftp-gwp-running t)
  541. (defvar ange-ftp-gwp-status nil)
  542.  
  543. (defun ange-ftp-gwp-sentinel (proc str)
  544.   (setq ange-ftp-gwp-running nil))
  545.  
  546. (defun ange-ftp-gwp-filter (proc str)
  547.   (ange-ftp-process-log-string proc str)
  548.   (cond ((string-match "login:" str)
  549.      (send-string proc
  550.               (concat
  551.                (let ((ange-ftp-default-user t))
  552.              (ange-ftp-get-user ange-ftp-gateway-host))
  553.                "\n")))
  554.     ((string-match "Password:" str)
  555.      (send-string proc
  556.               (concat
  557.                (ange-ftp-get-passwd ange-ftp-gateway-host
  558.                         (ange-ftp-get-user ange-ftp-gateway-host))
  559.                "\n")))
  560.     ((string-match "Connection closed\\|No such host" str)
  561.      (delete-process proc)
  562.      (setq ange-ftp-gwp-running nil))
  563.     ((string-match ange-ftp-gateway-prompt-pattern str)
  564.      (setq ange-ftp-gwp-running nil
  565.            ange-ftp-gwp-status t))))
  566.  
  567. (defun ange-ftp-gwp-start (host user name args)
  568.   "Login to the gateway machine and fire up an ftp process."
  569.   (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
  570.      (proc (start-process name name 
  571.                   ange-ftp-gateway-program
  572.                   ange-ftp-gateway-host))
  573.      (ftp (mapconcat (function (lambda (x) x)) args " ")))
  574.     (process-kill-without-query proc)
  575.     (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
  576.     (set-process-filter proc (function ange-ftp-gwp-filter))
  577.     (setq ange-ftp-gwp-running t
  578.       ange-ftp-gwp-status nil)
  579.     (message "Connecting to gateway %s..." ange-ftp-gateway-host)
  580.     (while ange-ftp-gwp-running        ;perform login sequence
  581.       (accept-process-output proc))
  582.     (if (not ange-ftp-gwp-status)
  583.     (ange-ftp-error host user "unable to login to gateway"))
  584.     (message "Connecting to gateway %s...done" ange-ftp-gateway-host)
  585.     (setq ange-ftp-gwp-running t
  586.       ange-ftp-gwp-status nil)
  587.     (process-send-string proc ange-ftp-gateway-setup-term-command)
  588.     (while ange-ftp-gwp-running        ;zap ^M's and double echoing.
  589.       (accept-process-output proc))
  590.     (if (not ange-ftp-gwp-status)
  591.     (ange-ftp-error host user "unable to set terminal modes on gateway"))
  592.     (setq ange-ftp-gwp-running t
  593.       ange-ftp-gwp-status nil)
  594.     (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
  595.     proc))
  596.  
  597. ;;;; ------------------------------------------------------------
  598. ;;;; Support for sending commands to the ftp process.
  599. ;;;; ------------------------------------------------------------
  600.  
  601. (defun ange-ftp-raw-send-cmd (proc cmd)
  602.   "Low-level routine to send the given ftp CMD to the ftp PROCESS.
  603. Returns non-nil if successful."
  604.   (if (eq (process-status proc) 'run)
  605.       (save-excursion
  606.     (setq ange-ftp-process-string ""
  607.           ange-ftp-process-running t
  608.           ange-ftp-process-status nil)
  609.     (send-string proc (concat cmd "\n"))
  610.     (while ange-ftp-process-running
  611.       (accept-process-output proc))
  612.     ange-ftp-process-status)))
  613.  
  614. (defun ange-ftp-start-process (host user name)
  615.   "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
  616. If HOST is only ftp-able through a gateway machine then spawn a shell
  617. on the gateway machine to do the ftp instead."
  618.   (let ((args '("ftp" "-i" "-n" "-g" "-v"))
  619.     proc)
  620.     (if (ange-ftp-use-gateway-p host)
  621.     (if ange-ftp-gateway-program-interactive
  622.         (setq proc (ange-ftp-gwp-start host user name args))
  623.       (setq proc (apply 'start-process name name
  624.                 (append (list ange-ftp-gateway-program
  625.                       ange-ftp-gateway-host)
  626.                     args))))
  627.       (setq proc (apply 'start-process name name args)))
  628.     (process-kill-without-query proc)
  629.     (set-process-sentinel proc (function ange-ftp-process-sentinel))
  630.     (set-process-filter proc (function ange-ftp-process-filter))
  631.     (accept-process-output proc)    ;wait for ftp startup message
  632.     proc))
  633.  
  634. (defun ange-ftp-get-process (host user)
  635.   "Return the process object for a ftp process connected to HOST and
  636. logged in as USER.  Create a new proces if needed."
  637.   (let* ((name (ange-ftp-ftp-process-buffer host user))
  638.      (proc (get-process name)))
  639.     (if (and proc (eq (process-status proc) 'run))
  640.     proc
  641.       (let ((pass (ange-ftp-get-passwd host user)))
  642.     (setq proc (ange-ftp-start-process host user name))
  643.     (message "Opening FTP connection to %s..." host)
  644.     (or (ange-ftp-raw-send-cmd proc (format "open %s" host))
  645.         (ange-ftp-error host user "OPEN request failed"))
  646.     (message "Logging in as user %s@%s..." user host)
  647.     (or (ange-ftp-raw-send-cmd proc (format "user \"%s\" \"%s\"" user pass))
  648.         (progn
  649.           (ange-ftp-set-passwd host user nil) ;reset password.
  650.           (ange-ftp-error host user "USER request failed")))
  651.     (message "Logging in as user %s@%s...done" user host)
  652.     proc))))
  653.  
  654. (defun ange-ftp-send-cmd (host user cmd)
  655.   "Find an ftp process connected to HOST logged in as USER and send it CMD.
  656. Returns whether successful."
  657.   (let ((proc (ange-ftp-get-process host user)))
  658.     (or (ange-ftp-raw-send-cmd proc cmd)
  659.     ;; Failed, try once more.
  660.     (and (setq proc (ange-ftp-get-process host user))
  661.          (ange-ftp-raw-send-cmd proc cmd)))))
  662.  
  663. ;;;; ------------------------------------------------------------
  664. ;;;; Remote pathname syntax support.
  665. ;;;; ------------------------------------------------------------
  666.  
  667. (defmacro ange-ftp-ftp-path-component (n)
  668.   "Extract the Nth ftp path component."
  669.   (` (let ((elt (nth (, n) ns)))
  670.        (substring path (match-beginning elt) (match-end elt)))))
  671.  
  672. (defun ange-ftp-ftp-path (path)
  673.   "Parse PATH according to ange-ftp-path-format (which see).
  674. Returns a list (HOST USER PATH), or nil if PATH does not match the format."
  675.   (if (string-match (car ange-ftp-path-format) path)
  676.       (let* ((ns (cdr ange-ftp-path-format))
  677.          (host (ange-ftp-ftp-path-component 0))
  678.          (user (ange-ftp-ftp-path-component 1))
  679.          (path (ange-ftp-ftp-path-component 2)))
  680.     (if (zerop (length user))
  681.         (setq user (ange-ftp-get-user host)))
  682.     (if (zerop (length path))
  683.         (setq path "/"))
  684.     (list host user path))
  685.     nil))
  686.  
  687. ;;;; ------------------------------------------------------------
  688. ;;;; Remote file and directory listing support.
  689. ;;;; ------------------------------------------------------------
  690.  
  691. (defun ange-ftp-dumb-host (host)
  692.   "Returns whether HOST's ftp daemon doesn't like \'ls\' or \'dir\' commands
  693. to take switch arguments."
  694.   (and ange-ftp-dumb-host-regexp
  695.        (string-match ange-ftp-dumb-host-regexp host)))
  696.  
  697. (defun ange-ftp-ls (file lsargs &optional want-buffer)
  698.   "Return the output of an `ls' command done on a remote machine using ftp.
  699. The first argument FILE is the full name of the remote file, the second arg
  700. LSARGS is any args to pass to the `ls' command, and the optional third arg
  701. WANT-BUFFER indicates that a buffer object should be returned rather than
  702. a string object."
  703.   (let ((parsed (ange-ftp-ftp-path file)))
  704.     (if parsed
  705.     (let* ((host (nth 0 parsed))
  706.            (user (nth 1 parsed))
  707.            (path (nth 2 parsed))
  708.            (temp (ange-ftp-make-tmp-name host))
  709.            lscmd)
  710.       (if (ange-ftp-dumb-host host)
  711.           (setq lscmd (concat "dir " path " " temp))
  712.         (if ange-ftp-ls-follow-symbolic-links
  713.         (if (> (length lsargs) 0)
  714.             (setq lsargs (concat lsargs "L"))
  715.           (setq lsargs "-L")))
  716.         (setq lscmd (format "ls \"%s %s\" %s" lsargs path temp)))
  717.       (message "Listing %s..." file)
  718.       (if (ange-ftp-send-cmd host user lscmd)
  719.           (let (data)
  720.         (save-excursion
  721.           (set-buffer (get-buffer-create ange-ftp-data-buffer-name))
  722.           (erase-buffer)
  723.           (if (file-readable-p temp)
  724.               (insert-file-contents temp)
  725.             (ange-ftp-error host user
  726.                     (format "list data file %s not readable"
  727.                         temp)))
  728. ;;          (ange-ftp-process-log-string ;debugging
  729. ;;           (ange-ftp-get-process host user)
  730. ;;           (buffer-substring (point-min) (point-max)))
  731.           (if want-buffer
  732.               (setq data (current-buffer))
  733.             (setq data (buffer-substring (point-min) (point-max)))
  734.             (kill-buffer (current-buffer)))
  735.           (condition-case () (delete-file temp) (error nil)))
  736.         (message "Listing %s...done" file)
  737.         data)
  738.         (ange-ftp-error host user "Unable to get a remote ls"))))))
  739.  
  740. ;;;; ------------------------------------------------------------
  741. ;;;; Directory information caching support.
  742. ;;;; ------------------------------------------------------------
  743.  
  744. (defun ange-ftp-parse-filename ()
  745.   "Extract the filename from the current line of a dired-like listing."
  746.   (save-excursion
  747.     (let ((eol (progn (end-of-line) (point))))
  748.       (beginning-of-line)
  749.       (if (re-search-forward
  750.        "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
  751.        eol t)
  752.       (progn (skip-chars-forward " ")
  753.          (skip-chars-forward "^ " eol)
  754.          (skip-chars-forward " " eol)
  755.          (let ((beg (point)))
  756.            (skip-chars-forward "^ \n")
  757. ;;               (skip-chars-backward "*/@")
  758.            (buffer-substring beg (point))))))))
  759.  
  760. (defun ange-ftp-parse-dired-listing ()
  761.   "Parse the current buffer which is assumed to be in a dired-like listing
  762. format, and return a hashtable as the result."
  763.   (let ((tbl (ange-ftp-make-hashtable)))
  764.     (goto-char (point-min))
  765.     (if (looking-at "[\t ]*total")
  766.     (progn
  767.       (forward-line 1)            ;Skip over total byte count.
  768.       (let (file)
  769.         (while (setq file (ange-ftp-parse-filename))
  770.           (beginning-of-line)
  771. ;;          (skip-chars-forward "\t 0-9")
  772.           (ange-ftp-put-hash-entry file (looking-at "d") tbl)
  773.           (forward-line 1)))
  774.       (ange-ftp-put-hash-entry "." t tbl)
  775.       (ange-ftp-put-hash-entry ".." t tbl)))
  776.     tbl))
  777.  
  778. (defun ange-ftp-set-files (directory files)
  779.   "For a given DIRECTORY, set or change the associated FILES hashtable."
  780.   (ange-ftp-put-hash-entry directory files ange-ftp-files-hashtable))
  781.  
  782. (defun ange-ftp-get-files (directory)
  783.   "Given a given DIRECTORY, return a hashtable of file entries."
  784.   (setq directory (file-name-as-directory directory)) ;normalize
  785.   (let ((files (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)))
  786.     (or files
  787.     (save-excursion
  788.       (set-buffer (ange-ftp-ls directory "-al" t))
  789.       (let ((files (ange-ftp-parse-dired-listing)))
  790.         (ange-ftp-put-hash-entry directory
  791.                      files
  792.                      ange-ftp-files-hashtable)
  793.         (kill-buffer (current-buffer))
  794.         files)))))
  795.  
  796. (defun ange-ftp-parse-path (path)
  797.   "Break apart PATH into its directory and file parts."
  798.   (let ((directory (file-name-directory path))
  799.     (file (file-name-nondirectory path)))
  800.     (if (equal directory "/")        ;file name syntax kludge
  801.     (progn
  802.       (setq directory (file-name-as-directory path))
  803.       (setq file "."))
  804.       (if (equal file "")        ;kludge #2
  805.       (setq file ".")))
  806.     (cons directory file)))
  807.  
  808. (defun ange-ftp-get-file-entry (path)
  809.   "Given PATH, return whether the given file entry.  At the moment
  810. this returns whether PATH is a directory or not."
  811.   (let* ((parsed (ange-ftp-parse-path path))
  812.      (directory (car parsed))
  813.      (file (cdr parsed)))
  814.     (ange-ftp-get-hash-entry file (ange-ftp-get-files directory))))
  815.  
  816. (defun ange-ftp-file-entry-p (path)
  817.   "Given PATH, return whether there is a file entry for it."
  818.   (let* ((parsed (ange-ftp-parse-path path))
  819.      (directory (car parsed))
  820.      (file (cdr parsed)))
  821.     (ange-ftp-hash-entry-exists-p file (ange-ftp-get-files directory))))
  822.  
  823. (defun ange-ftp-delete-file-entry (path)
  824.   "Given a PATH, delete the file entry for it, if it exists."
  825.   (let* ((parsed (ange-ftp-parse-path path))
  826.      (directory (car parsed))
  827.      (file (cdr parsed))
  828.      (files (ange-ftp-get-hash-entry directory
  829.                      ange-ftp-files-hashtable)))
  830.     (if files
  831.     (ange-ftp-del-hash-entry file files))))
  832.  
  833. (defun ange-ftp-add-file-entry (path &optional dir-p)
  834.   "Given a PATH, add the file entry for it, if its directory info exists."
  835.   (let* ((parsed (ange-ftp-parse-path path))
  836.      (directory (car parsed))
  837.      (file (cdr parsed))
  838.      (files (ange-ftp-get-hash-entry directory
  839.                      ange-ftp-files-hashtable)))
  840.     (if files
  841.     (ange-ftp-put-hash-entry file dir-p files))))
  842.  
  843. (defun ange-ftp-wipe-file-entries (host user)
  844.   "Remove all file entry information for the given HOST, USER pair."
  845.   (ange-ftp-map-hashtable
  846.    (function
  847.     (lambda (key)
  848.       (let ((parsed (ange-ftp-ftp-path key)))
  849.     (if parsed
  850.         (let ((h (nth 0 parsed))
  851.           (u (nth 1 parsed)))
  852.           (if (and (equal host h) (equal user u))
  853.           (ange-ftp-del-hash-entry key
  854.                        ange-ftp-files-hashtable)))))))
  855.    ange-ftp-files-hashtable))
  856.  
  857. ;;;; ------------------------------------------------------------
  858. ;;;; File transfer mode support.
  859. ;;;; ------------------------------------------------------------
  860.  
  861. (defun ange-ftp-set-binary-mode (host user)
  862.   "Tell the ftp process for the given HOST & USER to switch to binary mode."
  863.   (ange-ftp-send-cmd host user "binary"))
  864.  
  865. (defun ange-ftp-set-ascii-mode (host user)
  866.   "Tell the ftp process for the given HOST & USER to switch to ascii mode."
  867.   (ange-ftp-send-cmd host user "ascii"))
  868.  
  869. ;;;; ------------------------------------------------------------
  870. ;;;; Redefinitions of standard GNU Emacs functions.
  871. ;;;; ------------------------------------------------------------
  872.  
  873. (defun ange-ftp-binary-file (file)
  874.   "Returns whether the given FILE is to be considered as a binary file for
  875. ftp transfers."
  876.   (string-match ange-ftp-binary-file-name-regexp file))
  877.  
  878. (defun ange-ftp-write-region (start end filename &optional append visit)
  879.   "Write current region into specified file.
  880. When called from a program, takes three arguments:
  881. START, END and FILENAME.  START and END are buffer positions.
  882. Optional fourth argument APPEND if non-nil means
  883.   append to existing file contents (if any).
  884. Optional fifth argument VISIT if t means
  885.   set last-save-file-modtime of buffer to this file's modtime
  886.   and mark buffer not modified.
  887. If VISIT is neither t nor nil, it means do not print
  888.   the \"Wrote file\" message.
  889.  
  890. Note that this function has been extended to deal with remote files using ftp."
  891.   (interactive "r\nFWrite region to file: ")
  892.   (setq filename (expand-file-name filename))
  893.   (let ((parsed (ange-ftp-ftp-path filename)))
  894.     (if parsed
  895.     (let* ((host (nth 0 parsed))
  896.            (user (nth 1 parsed))
  897.            (path (nth 2 parsed))
  898.            (temp (ange-ftp-make-tmp-name host))
  899.            (binary (ange-ftp-binary-file filename))
  900.            (cmd (if append "append" "put")))
  901.       (ange-ftp-real-write-region start end temp nil 'nomsg)
  902.       (message "Writing %s..." filename)
  903.       (unwind-protect
  904.           (progn
  905.         (if binary
  906.             (ange-ftp-set-binary-mode host user))
  907.         (or (ange-ftp-send-cmd host user
  908.                        (format "%s %s %s" cmd temp path))
  909.             (signal 'file-error
  910.                 (list
  911.                  "Opening output file"
  912.                  (format "Unable to %s remote file" (upcase cmd))
  913.                  filename))))
  914.         (delete-file temp)
  915.         (if binary 
  916.         (ange-ftp-set-ascii-mode host user)))
  917.       (if (eq visit t)
  918.           (progn
  919.         (ange-ftp-set-buffer-mode)
  920.         (setq buffer-file-name filename)
  921.         (set-buffer-modified-p nil)))
  922.       (message "Wrote %s" filename)
  923.       (ange-ftp-add-file-entry filename))
  924.       (ange-ftp-real-write-region start end filename append visit))))
  925.  
  926. (defun ange-ftp-insert-file-contents (filename &optional visit)
  927.   "Insert contents of file FILENAME after point.
  928. Returns list of absolute pathname and length of data inserted.
  929. If second argument VISIT is non-nil, the buffer's visited filename
  930. and last save file modtime are set, and it is marked unmodified.
  931. If visiting and the file does not exist, visiting is completed
  932. before the error is signaled.
  933.  
  934. Note this function has been extended to deal with remote files using ftp."
  935.   (barf-if-buffer-read-only)
  936.   (setq filename (expand-file-name filename))
  937.   (let ((parsed (ange-ftp-ftp-path filename)))
  938.     (if parsed
  939.     (let* ((host (nth 0 parsed))
  940.            (user (nth 1 parsed))
  941.            (path (nth 2 parsed))
  942.            (temp (ange-ftp-make-tmp-name host))
  943.            (binary (ange-ftp-binary-file filename))
  944.            result)
  945.       (if visit
  946.           (setq buffer-file-name filename))
  947.       (unwind-protect
  948.           (progn
  949.         (if binary
  950.             (ange-ftp-set-binary-mode host user))
  951.         (message "Retrieving %s..." filename)
  952.         (or (ange-ftp-send-cmd host user
  953.                        (format "get %s %s" path temp))
  954.             (signal 'file-error
  955.                 (list
  956.                  "Opening input file"
  957.                  "Unable to GET remote file"
  958.                  filename)))
  959.         (setq result (ange-ftp-real-insert-file-contents temp visit))
  960.         (message "Retrieving %s...done" filename))
  961.         (condition-case () (delete-file temp) (error nil))
  962.         (if binary
  963.         (ange-ftp-set-ascii-mode host user)))
  964.       (if visit
  965.           (setq buffer-file-name filename))
  966.       result)
  967.       (ange-ftp-real-insert-file-contents filename visit))))
  968.  
  969. (defun ange-ftp-revert-buffer (arg noconfirm)
  970.   "Revert this buffer from a remote file using ftp."
  971.   (let ((opoint (point)))
  972.     (cond ((null buffer-file-name)
  973.        (error "Buffer does not seem to be associated with any file"))
  974.       ((or noconfirm
  975.            (yes-or-no-p (format "Revert buffer from file %s? "
  976.                     buffer-file-name)))
  977.        (let ((buffer-read-only nil))
  978.          ;; Set buffer-file-name to nil
  979.          ;; so that we don't try to lock the file.
  980.          (let ((buffer-file-name nil))
  981.            (unlock-buffer)
  982.            (erase-buffer))
  983.          (insert-file-contents buffer-file-name t))
  984.        (goto-char (min opoint (point-max)))
  985.        (after-find-file nil)
  986.        t))))
  987.  
  988. (defun ange-ftp-file-exists-p (file)
  989.   "Return t if FILE exists."
  990.   (setq file (expand-file-name file))
  991.   (if (ange-ftp-ftp-path file)
  992.       (ange-ftp-file-entry-p file)
  993.     (ange-ftp-real-file-exists-p file)))
  994.  
  995. (defun ange-ftp-file-directory-p (file)
  996.   "Return t if FILENAME is the name of a directory as a file.
  997. A directory name spec may be given instead; then the value is t
  998. if the directory so specified exists and really is a directory.
  999.  
  1000. Note that this function has been extended to deal with remote files using ftp."
  1001.   (setq file (expand-file-name file))
  1002.   (if (ange-ftp-ftp-path file)
  1003.       (ange-ftp-get-file-entry file)
  1004.     (ange-ftp-real-file-directory-p file)))
  1005.  
  1006. (defun ange-ftp-directory-files (directory &optional full match)
  1007.   "Return a list of names of files in DIRECTORY.
  1008. If FULL is non-NIL, absolute pathnames of the files are returned.
  1009. If MATCH is non-NIL, only pathnames containing that regexp are returned.
  1010.  
  1011. Note that this function has been extended to deal with remote files using ftp."
  1012.   (setq directory (expand-file-name directory))
  1013.   (if (ange-ftp-ftp-path directory)
  1014.       (let (files)
  1015.     (setq directory (file-name-as-directory directory))
  1016.     (mapcar (function
  1017.          (lambda (f)
  1018.            (if full
  1019.                (setq f (concat directory f)))
  1020.            (if match
  1021.                (if (string-match match f)
  1022.                (setq files (cons f files)))
  1023.              (setq files (cons f files)))))
  1024.         (ange-ftp-hash-table-keys (ange-ftp-get-files directory)))
  1025.     (nreverse files))
  1026.     (ange-ftp-real-directory-files directory full match)))
  1027.  
  1028. (defun ange-ftp-file-attributes (file)
  1029.   "Return a list of attributes of file FILENAME.
  1030. Value is nil if specified file cannot be opened.
  1031. Otherwise, list elements are:
  1032.  0. t for directory, string (name linked to) for symbolic link, or nil.
  1033.  1. Number of links to file.
  1034.  2. File uid.
  1035.  3. File gid.
  1036.  4. Last access time, as a list of two integers.
  1037.   First integer has high-order 16 bits of time, second has low 16 bits.
  1038.  5. Last modification time, likewise.
  1039.  6. Last status change time, likewise.
  1040.  7. Size in bytes.
  1041.  8. File modes, as a string of ten letters or dashes as in ls -l.
  1042.  9. t iff file's gid would change if file were deleted and recreated.
  1043. 10. inode number.
  1044.  
  1045. Note that this function has been extended to deal with remote files using ftp."
  1046.   (setq file (expand-file-name file))
  1047.   (if (ange-ftp-ftp-path file)
  1048.       (if (ange-ftp-file-entry-p file)
  1049.       (list (ange-ftp-get-file-entry file) ;0
  1050.         nil            ;1
  1051.         nil            ;2
  1052.         nil            ;3
  1053.         nil            ;4
  1054.         nil            ;5
  1055.         nil            ;6
  1056.         nil            ;7
  1057.         nil            ;8
  1058.         nil            ;9
  1059.         nil            ;10
  1060.         ))
  1061.     (ange-ftp-real-file-attributes file)))
  1062.  
  1063. (defun ange-ftp-file-writable-p (file)
  1064.   "Return t if file FILENAME can be written or created by you.
  1065.  
  1066. Note that this function has been extended to deal with remote files using ftp."
  1067.   (setq file (expand-file-name file))
  1068.   (or (ange-ftp-ftp-path file)
  1069.       (ange-ftp-real-file-writable-p file)))
  1070.  
  1071. (defun ange-ftp-file-readable-p (file)
  1072.   "Return t if file FILENAME exists and can be read by you.
  1073.  
  1074. Note that this function has been extended to deal with remote files using ftp."
  1075.   (setq file (expand-file-name file))
  1076.   (or (ange-ftp-ftp-path file)
  1077.       (ange-ftp-real-file-readable-p file)))
  1078.  
  1079. (defun ange-ftp-delete-file (file)
  1080.   "Delete specified file.  One argument, a file name string.
  1081. If file has multiple names, it continues to exist with the other names.
  1082.  
  1083. Note that this function has been extended to deal with remote files using ftp."
  1084.   (interactive "fDelete file: ")
  1085.   (setq file (expand-file-name file))
  1086.   (let ((parsed (ange-ftp-ftp-path file)))
  1087.     (if parsed
  1088.     (let ((host (nth 0 parsed))
  1089.           (user (nth 1 parsed))
  1090.           (path (nth 2 parsed)))
  1091.       (message "Deleting %s..." file)
  1092.       (or (ange-ftp-send-cmd host user (concat "delete " path))
  1093.           (signal 'file-error
  1094.               (list
  1095.                "Removing old name"
  1096.                "Unable to execute remote DELETE command"
  1097.                path)))
  1098.       (message "Deleting %s...done" file)
  1099.       (ange-ftp-delete-file-entry file))
  1100.       (ange-ftp-real-delete-file file))))
  1101.  
  1102. (defun ange-ftp-verify-visited-file-modtime (buf)
  1103.   "Return t if last mod time of BUF's visited file matches what BUF records.
  1104. This means that the file has not been changed since it was visited or saved.
  1105.  
  1106. Note that this function has been extended to deal with remote files using ftp."
  1107.   (let ((name (buffer-file-name buf)))
  1108.     (if (and (stringp name) (ange-ftp-ftp-path name))
  1109.     t
  1110.       (ange-ftp-real-verify-visited-file-modtime buf))))
  1111.  
  1112. (defun ange-ftp-backup-buffer ()
  1113.   "Make a backup of the disk file visited by the current buffer, if appropriate.
  1114. This is normally done before saving the buffer the first time.
  1115. If the value is non-nil, it is the result of `file-modes' on the original file;
  1116. this means that the caller, after saving the buffer, should change the modes
  1117. of the new file to agree with the old modes.
  1118.  
  1119. Note that this function has been extended to deal with remote files using ftp."
  1120.   (if (and (stringp buffer-file-name) (ange-ftp-ftp-path buffer-file-name))
  1121.       nil
  1122.     (ange-ftp-real-backup-buffer)))
  1123.  
  1124. ;;;; ------------------------------------------------------------
  1125. ;;;; File copying support.
  1126. ;;;; ------------------------------------------------------------
  1127.  
  1128. (defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
  1129.   (if (file-exists-p absname)
  1130.       (if (not interactive)
  1131.       (signal 'file-already-exists (list absname))
  1132.     (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
  1133.                       absname querystring)))
  1134.         (signal 'file-already-exists (list absname))))))
  1135.  
  1136. (defun ange-ftp-copy-remote-to-local (remote local parsed)
  1137.   "Copy REMOTE file to LOCAL file, where the former is on a remote machine."
  1138.   (let ((host (nth 0 parsed))
  1139.     (user (nth 1 parsed))
  1140.     (path (nth 2 parsed))
  1141.     (binary (ange-ftp-binary-file remote))
  1142.     temp
  1143.     cmd)
  1144.     (if (not (ange-ftp-use-gateway-p host))
  1145.     (setq cmd (format "get %s %s" path local))
  1146.       (setq temp (ange-ftp-make-tmp-name host))
  1147.       (setq cmd (format "get %s %s" path temp)))
  1148.     (unwind-protect
  1149.     (progn
  1150.       (if binary
  1151.           (ange-ftp-set-binary-mode host user))
  1152.       (message "Copying %s to %s..." remote local)
  1153.       (or (ange-ftp-send-cmd host user cmd)
  1154.           (signal 'file-error
  1155.               (list
  1156.                "Opening output file"
  1157.                "Unable to GET remote file"
  1158.                remote)))
  1159.       (if temp (copy-file temp local t))
  1160.       (message "Copying %s to %s...done" remote local))
  1161.       (if binary
  1162.       (ange-ftp-set-ascii-mode host user))
  1163.       (if temp (delete-file temp)))))
  1164.  
  1165. (defun ange-ftp-copy-local-to-remote (local remote parsed)
  1166.   "Copy LOCAL file to REMOTE file where the latter is a file on a remote machine."
  1167.   (let ((host (nth 0 parsed))
  1168.     (user (nth 1 parsed))
  1169.     (path (nth 2 parsed))
  1170.     (binary (ange-ftp-binary-file local))
  1171.     temp
  1172.     cmd)
  1173.     (if (not (ange-ftp-use-gateway-p host))
  1174.     (setq cmd (format "put %s %s" local path))
  1175.       (setq temp (ange-ftp-make-tmp-name host))
  1176.       (setq cmd (format "put %s %s" temp path)))
  1177.     (unwind-protect
  1178.     (progn
  1179.       (if binary
  1180.           (ange-ftp-set-binary-mode host user))
  1181.       (message "Copying %s to %s..." local remote)
  1182.       (if temp (copy-file local temp t))
  1183.       (or (ange-ftp-send-cmd host user cmd)
  1184.           (signal 'file-error
  1185.               (list
  1186.                "Opening output file"
  1187.                "Unable to PUT remote file"
  1188.                remote)))
  1189.       (message "Copying %s to %s...done" local remote))
  1190.       (if binary
  1191.       (ange-ftp-set-ascii-mode host user))
  1192.       (if temp (delete-file temp)))
  1193.     (ange-ftp-add-file-entry remote)))
  1194.  
  1195. (defun ange-ftp-copy-remote-to-remote (f-file t-file f-parsed t-parsed)
  1196.   "Copy F-FILE to T-FILE, where both files are on remote machines."
  1197.   (let ((temp (make-temp-name ange-ftp-copy-tmp-name-template)))
  1198.     (unwind-protect
  1199.     (progn
  1200.       (ange-ftp-copy-remote-to-local f-file temp f-parsed)
  1201.       (ange-ftp-copy-local-to-remote temp t-file t-parsed))
  1202.       (delete-file temp))))
  1203.  
  1204. (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
  1205.                     keep-date)
  1206.   "Copy FILE to NEWNAME.  Both args strings.
  1207. Signals a  file-already-exists  error if NEWNAME already exists,
  1208. unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
  1209. A number as third arg means request confirmation if NEWNAME already exists.
  1210. This is what happens in interactive use with M-x.
  1211. Fourth arg non-nil means give the new file the same last-modified time
  1212. that the old one has.  (This works on only some systems.)
  1213.  
  1214. Note this function has been extended to deal with remote files using ftp."
  1215.   (interactive "fCopy file: \nFCopy %s to file: \np")
  1216.   (setq filename (expand-file-name filename)
  1217.     newname (expand-file-name newname))
  1218.   (let ((f-parsed (ange-ftp-ftp-path filename))
  1219.     (t-parsed (ange-ftp-ftp-path newname)))
  1220.     (if (and (or f-parsed t-parsed)
  1221.          (or (not ok-if-already-exists)
  1222.          (numberp ok-if-already-exists)))
  1223.     (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
  1224.                            (numberp ok-if-already-exists)))
  1225.     (if f-parsed
  1226.     (if t-parsed
  1227.         (ange-ftp-copy-remote-to-remote filename newname f-parsed t-parsed)
  1228.       (ange-ftp-copy-remote-to-local filename newname f-parsed))
  1229.       (if t-parsed
  1230.       (ange-ftp-copy-local-to-remote filename newname t-parsed)
  1231.     (ange-ftp-real-copy-file filename newname ok-if-already-exists keep-date)))))
  1232.  
  1233. ;;;; ------------------------------------------------------------
  1234. ;;;; Simple Dired support.
  1235. ;;;; ------------------------------------------------------------
  1236.  
  1237. (require 'dired)
  1238.  
  1239. (defun ange-ftp-dired-readin (dirname buffer)
  1240.   "Emulation of dired-readin with support for remote files using ftp."
  1241.   (save-excursion
  1242.     (message "Reading directory %s..." dirname)
  1243.     (set-buffer buffer)
  1244.     (let ((buffer-read-only nil))
  1245.       (widen)
  1246.       (erase-buffer)
  1247.       (setq dirname (expand-file-name dirname))
  1248.       (if (ange-ftp-ftp-path dirname)
  1249.       (progn (insert (ange-ftp-ls dirname dired-listing-switches))
  1250.          (ange-ftp-set-files dirname (ange-ftp-parse-dired-listing)))
  1251.     (if (file-directory-p dirname)
  1252.         (call-process "ls" nil buffer nil
  1253.               dired-listing-switches dirname)
  1254.       (let ((default-directory (file-name-directory dirname)))
  1255.         (call-process shell-file-name nil buffer nil
  1256.               "-c" (concat "ls " dired-listing-switches " "
  1257.                        (file-name-nondirectory dirname))))))
  1258.       (goto-char (point-min))
  1259.       (while (not (eobp))
  1260.     (insert "  ")
  1261.     (forward-line 1))
  1262.       (goto-char (point-min))))
  1263.   (message "Reading directory %s...done" dirname))
  1264.  
  1265. ;;;; ------------------------------------------------------------
  1266. ;;;; File name completion support.
  1267. ;;;; ------------------------------------------------------------
  1268.  
  1269. (defun ange-ftp-file-name-all-completions (file dir)
  1270.   "Return a list of all completions of file name FILE in directory DIR."
  1271.   (if (ange-ftp-ftp-path dir)
  1272.       (all-completions file (ange-ftp-get-files dir)
  1273.                (function (lambda (sym) (get sym 'active))))
  1274.     (file-name-all-completions file dir)))
  1275.  
  1276. (defun ange-ftp-file-name-completion (file dir)
  1277.   "Complete file name FILE in directory DIR.
  1278. Returns the longest string common to all filenames in DIR that start with FILE.
  1279. If there is only one and FILE matches it exactly, returns t.
  1280. Returns nil if DIR contains no name starting with FILE."
  1281.   (if (ange-ftp-ftp-path dir)
  1282.       (try-completion file (ange-ftp-get-files dir)
  1283.               (function (lambda (sym) (get sym 'active))))
  1284.     (file-name-completion file dir)))
  1285.  
  1286. (defun ange-ftp-quote-filename (file)
  1287.   "Quote $ as $$ to get it past substitute-in-file-name."
  1288.   (let (res)
  1289.     (mapcar
  1290.      (function (lambda (char)
  1291.          (if (= char ?$)
  1292.              (setq res (cons char res)))
  1293.          (setq res (cons char res))))
  1294.      file)
  1295.     (concat (nreverse res))))
  1296.  
  1297. (defun ange-ftp-read-file-name-internal (string dir action)
  1298.   "Emulates read-file-name-internal for ftp."
  1299.   (let (name realdir)
  1300.     (if (eq action 'lambda)
  1301.     (if (> (length string) 0)
  1302.         (ange-ftp-file-exists-p (substitute-in-file-name string)))
  1303.       (if (zerop (length string))
  1304.       (setq name string realdir dir)
  1305.     (setq string (substitute-in-file-name string)
  1306.           name (file-name-nondirectory string)
  1307.           realdir (file-name-directory string))
  1308.     (setq realdir (if realdir (expand-file-name realdir dir) dir)))
  1309.       (if action
  1310.       (ange-ftp-file-name-all-completions name realdir)
  1311.     (let ((specdir (file-name-directory string))
  1312.           (val (ange-ftp-file-name-completion name realdir)))
  1313.       (if (and specdir (stringp val))
  1314.           (ange-ftp-quote-filename (concat specdir val))
  1315.         val))))))
  1316.  
  1317.  
  1318. ;;;; ------------------------------------------------------------
  1319. ;;;; Bits and bobs to bolt ange-ftp into GNU Emacs.
  1320. ;;;; ------------------------------------------------------------
  1321.  
  1322. (defun ange-ftp-overwrite-fn (fun)
  1323.   "Replace FUN's function definition with ange-ftp-FUN's, saving the
  1324. original definition as ange-ftp-real-FUN."
  1325.   (let* ((name (symbol-name fun))
  1326.      (saved (intern (concat "ange-ftp-real-" name)))
  1327.      (new (intern (concat "ange-ftp-" name))))
  1328.     (or (fboundp saved)
  1329.     (fset saved (symbol-function fun)))
  1330.     (fset fun new)))
  1331.  
  1332. (ange-ftp-overwrite-fn 'insert-file-contents)
  1333. (ange-ftp-overwrite-fn 'dired-readin)
  1334. (ange-ftp-overwrite-fn 'directory-files)
  1335. (ange-ftp-overwrite-fn 'file-directory-p)
  1336. (ange-ftp-overwrite-fn 'file-writable-p)
  1337. (ange-ftp-overwrite-fn 'file-readable-p)
  1338. (ange-ftp-overwrite-fn 'delete-file)
  1339. (ange-ftp-overwrite-fn 'read-file-name-internal)
  1340. (ange-ftp-overwrite-fn 'verify-visited-file-modtime)
  1341. (ange-ftp-overwrite-fn 'file-exists-p)
  1342. (ange-ftp-overwrite-fn 'write-region)
  1343. (ange-ftp-overwrite-fn 'backup-buffer)
  1344. (ange-ftp-overwrite-fn 'copy-file)
  1345. (ange-ftp-overwrite-fn 'file-attributes)
  1346.  
  1347. (or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
  1348.     (setq find-file-hooks
  1349.       (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
  1350.  
  1351.  
  1352. ;;;; ------------------------------------------------------------
  1353. ;;;; Finally provide package.
  1354. ;;;; ------------------------------------------------------------
  1355.  
  1356. (provide 'ange-ftp)
  1357.  
  1358. ;;;; ------------------------------------------------------------
  1359. ;;;; Stuff still to do (volunteers welcome!)
  1360. ;;;; ------------------------------------------------------------
  1361. ;;
  1362. ;; - determine directory type even if parent directory is inaccessible
  1363. ;; - hostname aliasing
  1364. ;; - merge in explorer support
  1365. ;; - write VMS support
  1366. ;; - background copy
  1367. ;; - decent documentation
  1368.