annotate lisp/dired/ange-ftp.el @ 9:6f2bbbbbe05a

Added tag r19-15b5 for changeset 4b173ad71786
author cvs
date Mon, 13 Aug 2007 08:47:36 +0200
parents b82b59fe008d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; ange-ftp.el --- transparent FTP support for GNU Emacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;; Keywords: comm
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;; File: ange-ftp.el
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; RCS: Header: ange-ftp.el,v 4.20 92/08/14 17:04:34 ange Exp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;; Description: transparent FTP support for GNU Emacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;; Author: Andy Norman, ange@hplb.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; Created: Thu Oct 12 14:00:05 1989
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;; Modified: Wed May 3 00:50:40 1995 (Andy Norman) ange@hplb.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; Modified for XEmacs by jwz
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;;; Copyright (C) 1989, 1990, 1991, 1992 Andy Norman.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;;; Author: Andy Norman (ange@hplb.hpl.hp.com)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;;; This program is free software; you can redistribute it and/or modify
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;;; it under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;;; the Free Software Foundation; either version 1, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 ;;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 ;;; This program is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;;; GNU General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ;;; A copy of the GNU General Public License can be obtained from this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 ;;; program's author (send electronic mail to ange@hplb.hpl.hp.com) or from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 ;;; 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 ;;; Synched up with: Not synched with FSF.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 ;;; Description:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 ;;; This package attempts to make accessing files and directories using FTP
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 ;;; from within GNU Emacs as simple and transparent as possible. A subset of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 ;;; the common file-handling routines are extended to interact with FTP.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 ;;; Installation:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 ;;; Byte-compile ange-ftp.el to ange-ftp.elc and put them both in a directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 ;;; on your load-path. Load the package from your .emacs file with:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 ;;; (require 'ange-ftp).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 ;;; ange-ftp can't sensibly be auto-loaded; you are either using it, or you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 ;;; ain't.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 ;;; Usage:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 ;;; Some of the common GNU Emacs file-handling operations have been made
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 ;;; FTP-smart. If one of these routines is given a filename that matches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 ;;; '/user@host:path' then it will spawn an FTP process connecting to machine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 ;;; 'host' as account 'user' and perform its operation on the file 'path'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 ;;; For example: if find-file is given a filename of:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 ;;; /ange@anorman:/tmp/notes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 ;;; then ange-ftp will spawn an FTP process, connect to the host 'anorman' as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 ;;; contents of that file as if it were on the local filesystem. If ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 ;;; needed a password to connect then it would prompt the user in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 ;;; minibuffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 ;;; Extended filename syntax:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 ;;; The default extended filename syntax is '/user@host:path', where the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 ;;; 'user@' part may be omitted. This syntax can be customised to a certain
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 ;;; extent by changing ange-ftp-path-format. There are limitations.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 ;;; If the user part is omitted then ange-ftp will generate a default user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 ;;; instead whose value depends on the variable ange-ftp-default-user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 ;;; Passwords:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 ;;; A password is required for each host / user pair. This will be prompted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 ;;; for when needed, unless already set by calling ange-ftp-set-passwd, or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 ;;; specified in a *valid* ~/.netrc file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 ;;; Passwords for user "anonymous":
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 ;;; Passwords for the user "anonymous" (or "ftp") are handled specially. The
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 ;;; variable ange-ftp-generate-anonymous-password controls what happens: if
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 ;;; the value of this variable is a string, then this is used as the password;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 ;;; if non-nil, then a password is created from the name of the user and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 ;;; hostname of the machine on which GNU Emacs is running; if nil (the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 ;;; default) then the user is prompted for a password as normal.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 ;;; "Dumb" UNIX hosts:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 ;;; The FTP servers on some UNIX machines have problems if the 'ls' command is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 ;;; used.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 ;;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 ;;; limit itself to the DIR command and not 'ls' for a given UNIX host. Note
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 ;;; that this change will take effect for the current GNU Emacs session only.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 ;;; See below for a discussion of non-UNIX hosts. If a large number of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 ;;; machines with similar hostnames have this problem then it is easier to set
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 ;;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 ;;; is unable to automatically recognize dumb unix hosts.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ;;; File name completion:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 ;;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 ;;; To do filename completion, ange-ftp needs a listing from the remote host.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 ;;; Therefore, for very slow connections, it might not save any time.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 ;;; FTP processes:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 ;;; When ange-ftp starts up an FTP process, it leaves it running for speed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 ;;; purposes. Some FTP servers will close the connection after a period of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 ;;; time, but ange-ftp should be able to quietly reconnect the next time that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 ;;; the process is needed.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 ;;; The FTP process will be killed should the associated "*ftp user@host*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 ;;; buffer be deleted. This should not cause ange-ftp any grief.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 ;;; Binary file transfers:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 ;;; By default ange-ftp will transfer files in ASCII mode. If a file being
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 ;;; transferred matches the value of ange-ftp-binary-file-name-regexp then the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 ;;; FTP process will be toggled into BINARY mode before the transfer and back
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 ;;; to ASCII mode after the transfer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 ;;; Account passwords:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 ;;; Some FTP servers require an additional password which is sent by the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 ;;; ACCOUNT command. ange-ftp partially supports this by allowing the user to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 ;;; specify an account password by either calling ange-ftp-set-account, or by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 ;;; specifying an account token in the .netrc file. If the account password
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 ;;; is set by either of these methods then ange-ftp will issue an ACCOUNT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 ;;; command upon starting the FTP process.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 ;;; Preloading:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 ;;; ange-ftp can be preloaded, but must be put in the site-init.el file and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 ;;; not the site-load.el file in order for the documentation strings for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 ;;; functions being overloaded to be available.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 ;;; Status reports:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147 ;;; Most ange-ftp commands that talk to the FTP process output a status
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 ;;; message on what they are doing. In addition, ange-ftp can take advantage
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 ;;; of the FTP client's HASH command to display the status of transferring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 ;;; files and listing directories. See the documentation for the variables
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 ;;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 ;;; ange-ftp-process-verbose for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 ;;; Gateways:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 ;;; Sometimes it is neccessary for the FTP process to be run on a different
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 ;;; machine than the machine running GNU Emacs. This can happen when the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 ;;; local machine has restrictions on what hosts it can access.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 ;;; ange-ftp has support for running the ftp process on a different (gateway)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 ;;; machine. The way it works is as follows:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 ;;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 ;;; that doesn't have the access restrictions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 ;;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 ;;; that matches hosts that can be contacted from running a local ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 ;;; process, but fails to match hosts that can't be accessed locally. For
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 ;;; example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 ;;; "\\.hp\\.com$\\|^[^.]*$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 ;;; will match all hosts that are in the .hp.com domain, or don't have an
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 ;;; explicit domain in their name, but will fail to match hosts with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 ;;; explicit domains or that are specified by their ip address.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 ;;; 3) Using NFS and symlinks, make sure that there is a shared directory with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 ;;; the *same* name between the local machine and the gateway machine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 ;;; This directory is neccessary for temporary files created by ange-ftp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 ;;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 ;;; this directory plus an identifying filename prefix. For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 ;;; "/nfs/hplose/ange/ange-ftp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 ;;; where /nfs/hplose/ange is a directory that is shared between the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 ;;; gateway machine and the local machine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 ;;; The simplest way of getting a ftp process running on the gateway machine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 ;;; is if you can spawn a remote shell using either 'rsh' or 'remsh'. If you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 ;;; can't do this for some reason such as security then points 7 onwards will
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 ;;; discuss an alternative approach.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 ;;; 5) Set the variable ange-ftp-gateway-program to the name of the remote
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 ;;; shell process such as 'remsh' or 'rsh' if the default isn't correct.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 ;;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 ;;; isn't already. This tells ange-ftp that you are using a remote shell
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 ;;; rather than logging in using telnet or rlogin.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 ;;; That should be all you need to allow ange-ftp to spawn a ftp process on
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202 ;;; the gateway machine. If you have to use telnet or rlogin to get to the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 ;;; gateway machine then follow the instructions below.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
205 ;;; 7) Set the variable ange-ftp-gateway-program to the name of the program
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 ;;; that lets you log onto the gateway machine. This may be something like
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
207 ;;; telnet or rlogin.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
208 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 ;;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210 ;;; expression that matches the prompt you get when you login to the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 ;;; gateway machine. Be very specific here; this regexp must not match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
212 ;;; *anything* in your login banner except this prompt.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213 ;;; shell-prompt-pattern is far too general as it appears to match some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214 ;;; login banners from Sun machines. For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 ;;; "^$*$ *"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 ;;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 ;;; ange-ftp know that it has to "hand-hold" the login to the gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 ;;; machine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222 ;;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223 ;;; that will put the pty connected to the gateway machine into a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 ;;; no-echoing mode, and will strip off carriage-returns from output from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 ;;; the gateway machine. For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 ;;; "stty -onlcr -echo"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229 ;;; will work on HP-UX machines, whereas:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 ;;; "stty -echo nl"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 ;;; appears to work for some Sun machines.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235 ;;; That's all there is to it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 ;;; Smart gateways:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239 ;;; If you have a "smart" ftp program that allows you to issue commands like
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 ;;; "USER foo@bar" which do nice proxy things, then look at the variables
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
241 ;;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 ;;; Tips for using ange-ftp:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 ;;; 1. For dired to work on a host which marks symlinks with a trailing @ in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246 ;;; an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 ;;; Most UNIX systems do not do this, but ULTRIX does. If you think that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 ;;; there is a chance you might connect to an ULTRIX machine (such as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 ;;; prep.ai.mit.edu), then set this variable accordingly. This will have
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 ;;; the side effect that dired will have problems with symlinks whose names
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 ;;; end in an @. If you get youself into this situation then editing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252 ;;; dired's ls-switches to remove "F", will temporarily fix things.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 ;;; 2. If you know that you are connecting to a certain non-UNIX machine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255 ;;; frequently, and ange-ftp seems to be unable to guess its host-type,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 ;;; then setting the appropriate host-type regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 ;;; (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 ;;; ange-ftp-cms-host-regexp) accordingly should help. Also, please report
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259 ;;; ange-ftp's inability to recognize the host-type as a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 ;;; 3. For slow connections, you might get "listing unreadable" error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 ;;; messages, or get an empty buffer for a file that you know has something
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 ;;; in it. The solution is to increase the value of ange-ftp-retry-time.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264 ;;; Its default value is 5 which is plenty for reasonable connections.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 ;;; However, for some transatlantic connections I set this to 20.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 ;;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268 ;;; copying the file to the local machine, compressing it there, and then
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 ;;; sending it back. Binary file transfers between machines of different
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 ;;; architectures can be a risky business. Test things out first on some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271 ;;; test files. See "Bugs" below. Also, note that ange-ftp copies files by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272 ;;; moving them through the local machine. Again, be careful when doing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 ;;; this with binary files on non-Unix machines.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 ;;; 5. Beware that dired over ftp will use your setting of dired-no-confirm
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 ;;; (list of dired commands for which confirmation is not asked). You
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277 ;;; might want to reconsider your setting of this variable, because you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 ;;; might want confirmation for more commands on remote direds than on
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 ;;; local direds. For example, I strongly recommend that you not include
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 ;;; compress and uncompress in this list. If there is enough demand it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 ;;; might be a good idea to have an alist ange-ftp-dired-no-confirm of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282 ;;; pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283 ;;; is a list of commands for which confirmation would be suppressed. Then
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 ;;; remote dired listings would take their (buffer-local) value of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 ;;; dired-no-confirm from this alist. Who votes for this?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 ;;; ---------------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288 ;;; Non-UNIX support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 ;;; ---------------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 ;;; VMS support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 ;;; Ange-ftp has full support for VMS hosts, including tree dired support. It
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 ;;; should be able to automatically recognize any VMS machine. However, if it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 ;;; fails to do this, you can use the command ange-ftp-add-vms-host. As well,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 ;;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 ;;; would be grateful if you would report any failures to automatically
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 ;;; recognize a VMS host as a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 ;;; Filename Syntax:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 ;;; For ease of *implementation*, the user enters the VMS filename syntax in a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303 ;;; UNIX-y way. For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 ;;; PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 ;;; would be entered as:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 ;;; /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 ;;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 ;;; [.CSV.POLICY]RULES.MEM
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 ;;; you would type:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310 ;;; C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 ;;; A legal VMS filename is of the form: FILE.TYPE;##
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313 ;;; where FILE can be up to 39 characters
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 ;;; TYPE can be up to 39 characters
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315 ;;; ## is a version number (an integer between 1 and 32,767)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 ;;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 ;;; $ cannot begin a filename, and - cannot be used as the first or last
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318 ;;; character.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 ;;; Tips:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321 ;;; 1. Although VMS is not case sensitive, EMACS running under UNIX is.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 ;;; Therefore, to access a VMS file, you must enter the filename with upper
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 ;;; case letters.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 ;;; 2. To access the latest version of file under VMS, you use the filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325 ;;; without the ";" and version number. You should always edit the latest
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 ;;; version of a file. If you want to edit an earlier version, copy it to a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327 ;;; new file first. This has nothing to do with ange-ftp, but is simply
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328 ;;; good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 ;;; latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 ;;; inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 ;;; that VMS will not allow you to save the file because it will refuse to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 ;;; overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 ;;; attach the buffer to this file. To get out of this situation, M-x
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 ;;; write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 ;;; latest version of the file. For this reason, in tree dired "f"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336 ;;; (dired-find-file), always loads the file sans version, whereas "v",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 ;;; (dired-view-file), always loads the explicit version number. The
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338 ;;; reasoning being that it reasonable to view old versions of a file, but
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 ;;; not to edit them.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 ;;; 3. EMACS has a feature in which it does environment variable substitution
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 ;;; in filenames. Therefore, to enter a $ in a filename, you must quote it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 ;;; by typing $$. There is a bug in EMACS, in that it neglects to quote the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343 ;;; $'s in the default directory when it writes it in the minibuffer. You
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 ;;; must edit the minibuffer to quote the $'s manually. Hopefully, this bug
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 ;;; will be fixed in EMACS 19. If you use Sebastian Kremer's gmhist (V 4.26
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346 ;;; or newer), you will not have this problem.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 ;;; MTS support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 ;;; Ange-ftp has full support, including tree dired support, for hosts running
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 ;;; the Michigan terminal system. It should be able to automatically
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352 ;;; recognize any MTS machine. However, if it fails to do this, you can use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353 ;;; the command ange-ftp-add-mts-host. As well, you can set the variable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 ;;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
355 ;;; would report any failures to automatically recognize a MTS host as a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
356 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357 ;;; Filename syntax:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
358 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359 ;;; MTS filenames are entered in a UNIX-y way. For example, if your account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360 ;;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 ;;; entered as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 ;;; /YYYY@mtsg.ubc.ca:/XXXX:/FILE
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 ;;; In other words, MTS accounts are treated as UNIX directories. Of course,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 ;;; to access a file in another account, you must have access permission for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 ;;; it. If FILE were in your own account, then you could enter it in a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366 ;;; relative path fashion as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 ;;; /YYYY@mtsg.ubc.ca:FILE
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
368 ;;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369 ;;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 ;;; like.) MTS filenames are always in upper case, and hence be sure to enter
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 ;;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372 ;;; is.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 ;;; CMS support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376 ;;; Ange-ftp has full support, including tree dired support, for hosts running
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 ;;; CMS. It should be able to automatically recognize any CMS machine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
378 ;;; However, if it fails to do this, you can use the command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 ;;; ange-ftp-add-cms-host. As well, you can set the variable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 ;;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381 ;;; would report any failures to automatically recognize a CMS host as a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383 ;;; Filename syntax:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 ;;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 ;;; treated as UNIX directories. For example to access the file READ.ME in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 ;;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388 ;;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389 ;;; If *.301 is the default minidisk for this account, you could access
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 ;;; FOO.BAR on this minidisk as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 ;;; /anonymous@cuvmb.cc.columbia.edu:FOO.BAR
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392 ;;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393 ;;; up to 8 characters. Again, beware that CMS filenames are always upper
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394 ;;; case, and hence must be entered as such.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
396 ;;; Tips:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 ;;; 1. CMS machines, with the exception of anonymous accounts, nearly always
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 ;;; need an account password. To have ange-ftp send an account password,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
399 ;;; you can either include it in your .netrc file, or use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 ;;; ange-ftp-set-account.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
401 ;;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
402 ;;; can fix this.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 ;;; ------------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
405 ;;; Bugs:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
406 ;;; ------------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
407 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
408 ;;; 1. Umask problems:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
409 ;;; Be warned that files created by using ange-ftp will take account of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
410 ;;; umask of the ftp daemon process rather than the umask of the creating
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
411 ;;; user. This is particulary important when logging in as the root user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
412 ;;; The way that I tighten up the ftp daemon's umask under HP-UX is to make
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
413 ;;; sure that the umask is changed to 027 before I spawn /etc/inetd. I
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
414 ;;; suspect that there is something similar on other systems.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
415 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
416 ;;; 2. Some combinations of FTP clients and servers break and get out of sync
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
417 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
418 ;;; machines cause this problem for some FTP clients. Using
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
419 ;;; ange-ftp-kill-process can be used to restart the ftp process, which
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
420 ;;; should get things back in synch.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
421 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
422 ;;; 3. Ange-ftp does not check to make sure that when creating a new file,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 ;;; you provide a valid filename for the remote operating system.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 ;;; If you do not, then the remote FTP server will most likely
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425 ;;; translate your filename in some way. This may cause ange-ftp to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
426 ;;; get confused about what exactly is the name of the file. The
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427 ;;; most common causes of this are using lower case filenames on systems
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
428 ;;; which support only upper case, and using filenames which are too
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
429 ;;; long.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
430 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
431 ;;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
432 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
433 ;;; 5. Ange-ftp likes to use pty's to talk to its FTP processes. If GNU Emacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
434 ;;; for some reason creates a FTP process that only talks via pipes then
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
435 ;;; ange-ftp won't be getting the information it requires at the time that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
436 ;;; it wants it since pipes flush at different times to pty's. One
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 ;;; disgusting way around this problem is to talk to the FTP process via
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438 ;;; rlogin which does the 'right' things with pty's.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440 ;;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 ;;; worried about this too much. Eventually, we should have some caching
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 ;;; of the current minidisk.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
443 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 ;;; 7. Some CMS machines do not assign a default minidisk when you ftp them as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 ;;; anonymous. It is then necessary to guess a valid minidisk name, and cd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
446 ;;; to it. This is (understandably) beyond ange-ftp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
447 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
448 ;;; 8. Remote to remote copying of files on non-Unix machines can be risky.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
449 ;;; Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
450 ;;; will use binary mode for the copy. Between systems of different
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
451 ;;; architecture, this still may not be enough to guarantee the integrity
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
452 ;;; of binary files. Binary file transfers from VMS machines are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
453 ;;; particularly problematical. Should ange-ftp-binary-file-name-regexp be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
454 ;;; an alist of OS type, regexp pairs?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
455 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
456 ;;; 9. The code to do compression of files over ftp is not as careful as it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
457 ;;; should be. It deletes the old remote version of the file, before
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
458 ;;; actually checking if the local to remote transfer of the compressed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
459 ;;; file succeeds. Of course to delete the original version of the file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
460 ;;; after transferring the compressed version back is also dangerous,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
461 ;;; because some OS's have severe restrictions on the length of filenames,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
462 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 ;;; truncated. Then, ange-ftp would delete the only remaining version of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
464 ;;; the file. Maybe ange-ftp should make backups when it compresses files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
465 ;;; (of course, the backup "~" could also be truncated off, sigh...).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
466 ;;; Suggestions?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
467 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
468
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
469 ;;; 10. If a dir listing is attempted for an empty directory on (at least
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
470 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
471 ;;; I don't know how to get ange-ftp work to around it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
472 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
473 ;;; 11. Bombs on filenames that start with a space. Deals well with filenames
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
474 ;;; containing spaces, but beware that the remote ftpd may not like them
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
475 ;;; much.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
476 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
477 ;;; 12. No classic dired support for non-UNIX systems. Tree dired was enough.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
478 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
479 ;;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
480 ;;; with a trailing @ in a ls -alF listing. In order to account for this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
481 ;;; ange-ftp looks to chop trailing @'s off of symlink names when it is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
482 ;;; parsing a listing with the F switch. This will cause ange-ftp to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
483 ;;; incorrectly get the name of a symlink on a non-ULTRIX host if its name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
484 ;;; ends in an @. ange-ftp will correct itself if you take F out of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
485 ;;; dired ls switches (C-u s will allow you to edit the switches). The
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
486 ;;; dired buffer will be automatically reverted, which will allow ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
487 ;;; to fix its files hashtable. A cookie to anyone who can think of a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
488 ;;; fast, sure-fire way to recognize ULTRIX over ftp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
489
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
490 ;;; If you find any bugs or problems with this package, PLEASE either e-mail
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
491 ;;; the above author, or send a message to the ange-ftp-lovers mailing list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
492 ;;; below. Ideas and constructive comments are especially welcome.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
493
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
494 ;;; ange-ftp-lovers:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
495 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
496 ;;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
497 ;;; users of ange-ftp are welcome to subscribe (see below) and to discuss
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
498 ;;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
499 ;;; the mailing list.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
500 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
501 ;;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
502 ;;; list, please mail one of the following addresses:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
503 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
504 ;;; ange-ftp-lovers-request@anorman.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
505 ;;; or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
506 ;;; ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
507 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
508 ;;; Please don't forget the -request part.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
509 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
510 ;;; For mail to be posted directly to ange-ftp-lovers, send to one of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
511 ;;; following addresses:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
512 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
513 ;;; ange-ftp-lovers@anorman.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
514 ;;; or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
515 ;;; ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
516 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
517 ;;; Alternatively, there is a mailing list that only gets announcements of new
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
518 ;;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
519 ;;; subscribed to by e-mailing to the -request address as above. Please make
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
520 ;;; it clear in the request which mailing list you wish to join.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522 ;;; The latest version of ange-ftp can usually be obtained via anonymous ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 ;;; from:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524 ;;; alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 ;;; or:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
526 ;;; ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.tar.Z
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
527 ;;; or:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528 ;;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
529
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 ;;; The archives for ange-ftp-lovers can be found via anonymous ftp under:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 ;;; ftp.reed.edu:pub/mailing-lists/ange-ftp/
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
533
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
534 ;;; -----------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
535 ;;; Technical information on this package:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536 ;;; -----------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538 ;;; The following GNU Emacs functions are replaced by this package:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
539 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
540 ;;; write-region
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
541 ;;; insert-file-contents
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
542 ;;; dired-readin
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
543 ;;; dired-revert
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544 ;;; dired-call-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 ;;; diff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546 ;;; delete-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 ;;; read-file-name-internal
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
548 ;;; verify-visited-file-modtime
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
549 ;;; directory-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
550 ;;; backup-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
551 ;;; file-directory-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
552 ;;; file-writable-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
553 ;;; file-exists-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
554 ;;; file-readable-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
555 ;;; file-symlink-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
556 ;;; file-attributes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
557 ;;; copy-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
558 ;;; rename-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
559 ;;; file-name-as-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
560 ;;; file-name-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
561 ;;; file-name-nondirectory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
562 ;;; file-name-completion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
563 ;;; directory-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
564 ;;; expand-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
565 ;;; file-name-all-completions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
566
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
567 ;;; LISPDIR ENTRY for the Elisp Archive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
568 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
569 ;;; LCD Archive Entry:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
570 ;;; ange-ftp|Andy Norman|ange@hplb.hpl.hp.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
571 ;;; |transparent FTP Support for GNU Emacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
572 ;;; |Date: 92/08/14 17:04:34 |Revision: 4.20 |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
573
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
574 ;;; Checklist for adding non-UNIX support for TYPE
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
575 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
576 ;;; The following functions may need TYPE versions:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
577 ;;; (not all functions will be needed for every OS)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
578 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
579 ;;; ange-ftp-fix-path-for-TYPE
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
580 ;;; ange-ftp-fix-dir-path-for-TYPE
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
581 ;;; ange-ftp-TYPE-host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
582 ;;; ange-ftp-TYPE-add-host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
583 ;;; ange-ftp-parse-TYPE-listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
584 ;;; ange-ftp-TYPE-delete-file-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
585 ;;; ange-ftp-TYPE-add-file-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
586 ;;; ange-ftp-TYPE-file-name-as-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
587 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
588 ;;; Variables:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
589 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
590 ;;; ange-ftp-TYPE-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
591 ;;; May need to add TYPE to ange-ftp-dumb-host-types
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
592 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
593 ;;; Check the following functions for OS dependent coding:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
594 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
595 ;;; ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
596 ;;; ange-ftp-guess-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
597 ;;; ange-ftp-allow-child-lookup
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
598 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
599 ;;; For Tree Dired support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
600 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
601 ;;; ange-ftp-dired-TYPE-insert-headerline
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
602 ;;; ange-ftp-dired-TYPE-move-to-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
603 ;;; ange-ftp-dired-TYPE-move-to-end-of-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
604 ;;; ange-ftp-dired-TYPE-get-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
605 ;;; ange-ftp-dired-TYPE-between-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
606 ;;; ange-ftp-TYPE-make-compressed-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
607 ;;; ange-ftp-dired-TYPE-ls-trim
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
608 ;;; ange-ftp-TYPE-bob-version
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
609 ;;; ange-ftp-dired-TYPE-clean-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
610 ;;; ange-ftp-dired-TYPE-flag-backup-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
611 ;;; ange-ftp-dired-TYPE-backup-diff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
612 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
613 ;;; Variables for dired:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
614 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
615 ;;; ange-ftp-dired-TYPE-re-exe
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
616 ;;; ange-ftp-dired-TYPE-re-dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
617
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
618 ;;; Host type conventions:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
619 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
620 ;;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
621 ;;; (mostly) follow the following conventions for remote host types. At
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
622 ;;; least, I think that future code should try to follow these conventions,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
623 ;;; and the current code should eventually be made compliant.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
624 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
625 ;;; nil = local host type, whatever that is (probably unix).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
626 ;;; Think nil as in "not a remote host". This value is used by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
627 ;;; ange-ftp-dired-host-type for local buffers.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
628 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
629 ;;; t = a remote host of unknown type. Think t is in true, it's remote.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
630 ;;; Currently, 'unix is used as the default remote host type.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
631 ;;; Maybe we should use t.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
632 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
633 ;;; 'type = a remote host of TYPE type.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
634 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
635 ;;; 'type:list = a remote host of TYPE type, using a specialized ftp listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
636 ;;; program called list. This is currently only used for Unix
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
637 ;;; dl (descriptive listings), when ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
638 ;;; is set to 'unix:dl.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
639
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
640 ;;; Bug report codes:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
641 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
642 ;;; Because of their naive faith in this code, there are certain situations
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
643 ;;; which the writers of this program believe could never happen. However,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
644 ;;; being realists they have put calls to 'error in the program at these
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
645 ;;; points. These errors provide a code, which is an integer, greater than 1.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
646 ;;; To aid debugging. the error codes, and the functions in which they reside
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
647 ;;; are listed below.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
648 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
649 ;;; 1: See ange-ftp-ls
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
650 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
651
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
652 ;;; XEmacs changes from 4.20
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
653 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
654 ;;; - added gzip support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
655 ;;; - added "lazy" messages
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
656 ;;; - fixed completion list in the root dir (nil vs (nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
657 ;;; - use (message nil) to repaint minibuf instead of that awful kludge
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
658 ;;; - call compute-buffer-file-truename to set truenames properly for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
659 ;;; when find-file-compare-truenames is set
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
660 ;;; - make-directory takes a second optional argument
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
661 ;;; - made ange-ftp-overwrite-fn use the 19.8 interface to byte-code objects
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
662 ;;; - made ange-ftp-shell-mode work better with the latest comint
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
663 ;;; - insert-file-contents takes 2-5 args in v19
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
664 ;;; - moved invocation of shell-mode to get along with the latest shell-font.el
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
665 ;;; - implemented ange-ftp-read-passwd in terms of read-passwd (from passwd.el)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
666 ;;; - initialize all buffer-local variables to nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
667 ;;; - Apollo stuff from Bob Weiner
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
668
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
669
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
670 ;;; -----------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
671 ;;; Hall of fame:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
672 ;;; -----------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
673 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
674 ;;; Thanks to Roland McGrath for improving the filename syntax handling,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
675 ;;; for suggesting many enhancements and for numerous cleanups to the code.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
676 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
677 ;;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
678 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
679 ;;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
680 ;;; dired / shell auto-loading.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
681 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
682 ;;; Thanks to Sebastian Kremer for tree dired support and for many ideas and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
683 ;;; bugfixes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
684 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
685 ;;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
686 ;;; VOS support, and hostname completion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
687 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
688 ;;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
689 ;;; with file-name expansion, efficiency worries, stylistic concerns and many
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
690 ;;; bugfixes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
691 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
692 ;;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
693 ;;; MTS, CMS and UNIX-dls. Sandy also added dired-support for non-UNIX OS and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
694 ;;; auto-recognition of the host type.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
695 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
696 ;;; Thanks to Dave Smith who wrote the info file for ange-ftp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
697 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
698 ;;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
699 ;;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
700 ;;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
701 ;;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
702 ;;; Mathur, the folks on the ange-ftp-lovers mailing list and many others
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
703 ;;; whose names I've forgotten who have helped to debug and fix problems with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
704 ;;; ange-ftp.el.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
705
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
706 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
707 ;;;; User customization variables.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
708 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
709
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
710 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
711 (defvar ange-ftp-path-format
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
712 '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" . (3 2 4))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
713 "*Format of a fully expanded remote pathname. This is a cons
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
714 \(REGEXP . \(HOST USER PATH\)\), where REGEXP is a regular expression matching
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
715 the full remote pathname, and HOST, USER, and PATH are the numbers of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
716 parenthesized expressions in REGEXP for the components (in that order).")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
717
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
718 ;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
719 ;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
720 ;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
721
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
722 ;; XEmacs patch from Bob Weiner
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
723 (defvar ange-ftp-multi-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
724 "^331-\\|^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^530-\\|^4[25]1-"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
725 "*Regular expression matching messages from the ftp process that start
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
726 a multiline reply.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
727
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
728 (defvar ange-ftp-good-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
729 "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
730 "*Regular expression matching messages from the ftp process that indicate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
731 that the action that was initiated has completed successfully.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
732
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
733 ;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
734 ;; Also CMS machines use a multiline 550- reply to say that you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
735 ;; don't have write permission. ange-ftp gets into multi-line skip
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
736 ;; mode and hangs. Have it ignore 550- instead. It will then barf
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
737 ;; when it gets the 550 line, as it should.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
738
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
739 (defvar ange-ftp-skip-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
740 (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
741 "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
742 "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
743 "*Regular expression matching messages from the ftp process that can be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
744 ignored.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
745
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
746 (defvar ange-ftp-fatal-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
747 (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
748 "^No control connection\\|unknown host\\|^lost connection")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
749 "*Regular expression matching messages from the FTP process that indicate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
750 something has gone drastically wrong attempting the action that was
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
751 initiated and that the FTP process should (or already has) been killed.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
752
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
753 (defvar ange-ftp-gateway-fatal-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
754 "No route to host\\|Connection closed\\|No such host\\|Login incorrect"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
755 "*Regular expression matching messages from the rlogin / telnet process that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
756 indicates that logging in to the gateway machine has gone wrong.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
757
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
758 (defvar ange-ftp-xfer-size-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
759 "^150 .* connection for .* (\\([0-9]+\\) bytes)"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
760 "*Regular expression used to determine the number of bytes in a FTP transfer.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
761
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
762 (defvar ange-ftp-tmp-name-template "/tmp/ange-ftp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
763 "*Template used to create temporary files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
764
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
765 (defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
766 "*Template used to create temporary files when ftp-ing through a gateway.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
767 Files starting with this prefix need to be accessible from BOTH the local
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
768 machine and the gateway machine, and need to have the SAME name on both
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
769 machines, that is, /tmp is probably NOT what you want, since that is rarely
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
770 cross-mounted.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
771
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
772 (defvar ange-ftp-netrc-filename "~/.netrc"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
773 "*File in .netrc format to search for passwords.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
774
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
775 (defvar ange-ftp-disable-netrc-security-check nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
776 "*If non-nil avoid checking permissions on the .netrc file.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
777
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
778 (defvar ange-ftp-default-user "anonymous"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
779 "*User name to use when none is specied in a pathname.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
780 If nil, then the name under which the user is logged in is used.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
781 If non-nil but not a string, the user is prompted for the name.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
782
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
783 (defvar ange-ftp-default-password nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
784 "*Password to use when the user is the same as ange-ftp-default-user.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
785
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
786 (defvar ange-ftp-default-account nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
787 "*Account password to use when the user is the same as ange-ftp-default-user.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
788
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
789 (defvar ange-ftp-generate-anonymous-password t ;; changed wing@666.com
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
790 "*If t, use a password of user@host when logging in as the anonymous user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
791 If a string then use that as the password.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
792 If nil then prompt the user for a password.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
793
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
794 (defvar ange-ftp-dumb-unix-host-regexp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
795 "*If non-nil, if the host being ftp'd to matches this regexp then the FTP
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
796 process uses the \'dir\' command to get directory information.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
797
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
798 (defvar ange-ftp-binary-file-name-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
799 (concat "\\.g?z$\\|\\.Z$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
800 "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
801 "\\.EXE\\(;[0-9]+\\)?$\\|\\.g?z-part-..$\\|\\.Z-part-..$")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
802 "*If a file matches this regexp then it is transferred in binary mode.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
803
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
804 (defvar ange-ftp-gateway-host nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
805 "*Name of host to use as gateway machine when local FTP isn't possible.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
806
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
807 (defvar ange-ftp-local-host-regexp ".*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
808 "*If a host being FTP'd to matches this regexp then the ftp process is started
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
809 locally, otherwise the FTP process is started on \`ange-ftp-gateway-host\'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
810 instead.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
811
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
812 (defvar ange-ftp-gateway-program-interactive nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
813 "*If non-nil then the gateway program is expected to connect to the gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
814 machine and eventually give a shell prompt. Both telnet and rlogin do something
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
815 like this.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
816
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
817 (defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
818 "*Name of program to spawn a shell on the gateway machine. Valid candidates
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
819 are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
820 above.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
821
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
822 (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
823 "*Regexp used to detect that the logging-in sequence is completed on the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
824 gateway machine and that the shell is now awaiting input. Make this regexp as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
825 strict as possible; it shouldn't match *anything* at all except the user's
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
826 initial prompt. The above string will fail under most SUN-3's since it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
827 matches the login banner.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
828
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
829 (defvar ange-ftp-gateway-setup-term-command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
830 (if (eq system-type 'hpux)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
831 "stty -onlcr -echo\n"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
832 "stty -echo nl\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
833 "*Command to use after logging in to the gateway machine to stop the terminal
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
834 echoing each command and to strip out trailing ^M characters.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
835
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
836 (defvar ange-ftp-smart-gateway nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
837 "*If the gateway FTP is smart enough to use proxy server, then don't bother
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
838 telnetting etc, just issue a user@host command instead.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
839
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
840 (defvar ange-ftp-smart-gateway-port "21"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
841 "*Port on gateway machine to use when smart gateway is in operation.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
842
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
843 (defvar ange-ftp-send-hash t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
844 "*If non-nil, send the HASH command to the FTP client.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
845
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
846 (defvar ange-ftp-binary-hash-mark-size nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
847 "*Default size, in bytes, between hash-marks when transferring a binary file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
848 If NIL, this variable will be locally overridden if the FTP client outputs a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
849 suitable response to the HASH command. If non-NIL then this value takes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
850 precedence over the local value.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
851
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
852 (defvar ange-ftp-ascii-hash-mark-size 1024
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
853 "*Default size, in bytes, between hash-marks when transferring an ASCII file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
854 This variable is buffer-local and will be locally overridden if the FTP client
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
855 outputs a suitable response to the HASH command.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
856
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
857 (defvar ange-ftp-process-verbose t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
858 "*If non-NIL then be chatty about interaction with the FTP process.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
859
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
860 (defvar ange-ftp-ftp-program-name "ftp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
861 "*Name of FTP program to run.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
862
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
863 (defvar ange-ftp-gateway-ftp-program-name "ftp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
864 "*Name of FTP program to run on gateway machine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
865 Some AT&T folks claim to use something called `pftp' here.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
866
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
867 (defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
868 "*A list of arguments passed to the FTP program when started.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
869
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
870 (defvar ange-ftp-nslookup-program nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
871 "*If non-NIL then a string naming nslookup program." )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
872
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
873 (defvar ange-ftp-make-backup-files ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
874 "*A list of operating systems for which ange-ftp will make Emacs backup
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
875 files on the remote host. For example, '\(unix\) makes sense, but
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
876 '\(unix vms\) or '\(vms\) would be silly, since vms makes its own backups.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
877
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
878 (defvar ange-ftp-retry-time 5
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
879 "*Number of seconds to wait before retrying if a file or listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
880 doesn't arrive. This might need to be increased for very slow connections.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
881
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
882 (defvar ange-ftp-auto-save 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
883 "If 1, allows ange-ftp files to be auto-saved.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
884 If 0, suppresses auto-saving of ange-ftp files.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
885 Don't use any other value.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
886
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
887 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
888 ;;;; Hash table support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
889 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
890
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
891 (require 'backquote)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
892
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
893 (defun ange-ftp-make-hashtable (&optional size)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
894 "Make an obarray suitable for use as a hashtable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
895 SIZE, if supplied, should be a prime number."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
896 (make-vector (or size 31) 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
897
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
898 (defun ange-ftp-map-hashtable (fun tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
899 "Call FUNCTION on each key and value in HASHTABLE."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
900 (mapatoms
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
901 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
902 (lambda (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
903 (funcall fun (get sym 'key) (get sym 'val))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
904 tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
905
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
906 (defmacro ange-ftp-make-hash-key (key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
907 "Convert KEY into a suitable key for a hashtable."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
908 (` (if (stringp (, key))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
909 (, key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
910 (prin1-to-string (, key)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
911
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
912 (defun ange-ftp-get-hash-entry (key tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
913 "Return the value associated with KEY in HASHTABLE."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
914 (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
915 (and sym (get sym 'val))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
916
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
917 (defun ange-ftp-put-hash-entry (key val tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
918 "Record an association between KEY and VALUE in HASHTABLE."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
919 (let ((sym (intern (ange-ftp-make-hash-key key) tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
920 (put sym 'val val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
921 (put sym 'key key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
922
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
923 (defun ange-ftp-del-hash-entry (key tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
924 "Copy all symbols except KEY in HASHTABLE and return modified hashtable."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
925 (let* ((len (length tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
926 (new-tbl (ange-ftp-make-hashtable len))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
927 (i (1- len)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
928 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
929 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
930 (lambda (k v)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
931 (or (equal k key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
932 (ange-ftp-put-hash-entry k v new-tbl))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
933 tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
934 (while (>= i 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
935 (aset tbl i (aref new-tbl i))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
936 (setq i (1- i)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
937 tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
938
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
939 (defun ange-ftp-hash-entry-exists-p (key tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
940 "Return whether there is an association for KEY in TABLE."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
941 (intern-soft (ange-ftp-make-hash-key key) tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
942
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
943 (defun ange-ftp-hash-table-keys (tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
944 "Return a sorted list of all the active keys in the hashtable, as strings."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
945 (sort (all-completions "" tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
946 (function string-lessp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
947
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
948 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
949 ;;;; Internal variables.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
950 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
951
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
952 (defconst ange-ftp-version "Revision: 4.20.XEmacs")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
953
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
954 (defvar ange-ftp-data-buffer-name " *ftp data*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
955 "Buffer name to hold directory listing data received from ftp process.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
956
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
957 (defvar ange-ftp-netrc-modtime nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
958 "Last modified time of the netrc file from file-attributes.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
959
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
960 (defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
961 "Hash table holding associations between HOST, USER pairs.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
962
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
963 (defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
964 "Mapping between a HOST, USER pair and a PASSWORD for them.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
965
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
966 (defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
967 "Mapping between a HOST, USER pair and a ACCOUNT password for them.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
968
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
969 (defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
970 "Hash table for storing directories and their respective files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
971
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
972 (defvar ange-ftp-ls-cache-lsargs nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
973 "Last set of args used by ange-ftp-ls.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
974
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
975 (defvar ange-ftp-ls-cache-file nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
976 "Last file passed to ange-ftp-ls.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
977
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
978 (defvar ange-ftp-ls-cache-res nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
979 "Last result returned from ange-ftp-ls.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
980
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
981 ;; New error symbols.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
982 ;; XEmacs change
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
983 (define-error 'ftp-error "FTP error" 'file-error)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
984
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
985 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
986 ;;; Match-data support (stolen from Kyle I think)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
987 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
988
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
989 (defmacro ange-ftp-save-match-data (&rest body)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
990 "Execute the BODY forms, restoring the global value of the match data.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
991 Before executing BODY, case-fold-search is locally bound to nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
992 (let ((original (make-symbol "match-data"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
993 case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
994 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
995 'let (list (list original '(match-data)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
996 (list 'unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
997 (cons 'progn body)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
998 (list 'store-match-data original)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
999
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1000 (put 'ange-ftp-save-match-data 'lisp-indent-hook 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1001 (put 'ange-ftp-save-match-data 'edebug-form-hook '(&rest form))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1002
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1003 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1004 ;;; Enhanced message support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1005 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1006
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1007 (defun ange-ftp-message (fmt &rest args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1008 "Output the given message, but truncate to the size of the minibuffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1009 window."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1010 (let ((msg (apply (function format) fmt args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1011 (max (window-width (minibuffer-window))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1012 (if (>= (length msg) max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1013 (setq msg (concat "> " (substring msg (- 3 max)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1014 (message "%s" msg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1015
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1016 (defvar ange-ftp-lazy-message-time 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1017 (defun ange-ftp-lazy-message (fmt &rest args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1018 "Output the given message, but truncate to the size of the minibuffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1019 window, and don't print the message if we've printed another message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1020 less than one second ago."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1021 (if (= ange-ftp-lazy-message-time
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1022 (setq ange-ftp-lazy-message-time (nth 1 (current-time))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1023 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1024 (apply 'ange-ftp-message fmt args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1025
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1026 (or (fboundp 'current-time) (fset 'ange-ftp-lazy-message 'ange-ftp-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1027
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1028
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1029 (defun ange-ftp-abbreviate-filename (file &optional new)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1030 "Abbreviate the given filename relative to the default-directory. If the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1031 optional parameter NEW is given and the non-directory parts match, only return
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1032 the directory part of the file."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1033 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1034 (if (and default-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1035 (string-match (concat "^"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1036 (regexp-quote default-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1037 ".") file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1038 (setq file (substring file (1- (match-end 0)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1039 (if (and new
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1040 (string-equal (file-name-nondirectory file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1041 (file-name-nondirectory new)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1042 (setq file (file-name-directory file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1043 (or file "./")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1044
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1045 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1046 ;;;; User / Host mapping support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1047 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1048
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1049 (defun ange-ftp-set-user (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1050 "For a given HOST, set or change the default USER."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1051 (interactive "sHost: \nsUser: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1052 (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1053
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1054 (defun ange-ftp-get-user (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1055 "Given a HOST, return the default USER."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1056 (ange-ftp-parse-netrc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1057 (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1058 (or user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1059 (prog1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1060 (setq user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1061 (cond ((stringp ange-ftp-default-user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1062 ;; We have a default name. Use it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1063 ange-ftp-default-user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1064 (ange-ftp-default-user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1065 ;; Ask the user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1066 (let ((enable-recursive-minibuffers t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1067 (read-string (format "User for %s: " host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1068 (user-login-name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1069 ;; Default to the user's login name.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1070 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1071 (user-login-name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1072 (ange-ftp-set-user host user)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1073
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1074 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1075 ;;;; Password support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1076 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1077
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1078 (defun ange-ftp-read-passwd (prompt &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1079 "Read a password from the user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1080 See documentation of `read-passwd' for more info."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1081 (read-passwd prompt nil default))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1082
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1083 ;(defun ange-ftp-read-passwd (prompt &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1084 ; "Read a password from the user. Echos a . for each character typed.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1085 ;End with RET, LFD, or ESC. DEL or C-h rubs out. ^U kills line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1086 ;Optional DEFAULT is password to start with."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1087 ; (let ((pass (if default default ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1088 ; (c 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1089 ; (echo-keystrokes 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1090 ; (cursor-in-echo-area t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1091 ; (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1092 ; (message "%s%s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1093 ; prompt
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1094 ; (make-string (length pass) ?.))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1095 ; (setq c (read-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1096 ; (if (= c ?\C-u)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1097 ; (setq pass "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1098 ; (if (and (/= c ?\b) (/= c ?\177))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1099 ; (setq pass (concat pass (char-to-string c)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1100 ; (if (> (length pass) 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1101 ; (setq pass (substring pass 0 -1))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1102 ; (ange-ftp-repaint-minibuffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1103 ; (substring pass 0 -1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1104
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1105 (defmacro ange-ftp-generate-passwd-key (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1106 (` (concat (, host) "/" (, user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1107
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1108 (defmacro ange-ftp-lookup-passwd (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1109 (` (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key (, host) (, user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1110 ange-ftp-passwd-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1111
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1112 (defun ange-ftp-set-passwd (host user passwd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1113 "For a given HOST and USER, set or change the associated PASSWORD."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1114 (interactive (list (read-string "Host: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1115 (read-string "User: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1116 (ange-ftp-read-passwd "Password: ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1117 (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1118 passwd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1119 ange-ftp-passwd-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1120
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1121 (defun ange-ftp-get-host-with-passwd (user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1122 "Given a USER, return a host we know the password for."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1123 (ange-ftp-parse-netrc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1124 (catch 'found-one
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1125 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1126 (function (lambda (host val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1127 (if (ange-ftp-lookup-passwd host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1128 (throw 'found-one host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1129 ange-ftp-user-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1130 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1131 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1132 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1133 (lambda (key value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1134 (if (string-match "^[^/]*\\(/\\).*$" key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1135 (let ((host (substring key 0 (match-beginning 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1136 (if (and (string-equal user (substring key (match-end 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1137 value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1138 (throw 'found-one host))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1139 ange-ftp-passwd-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1140 nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1141
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1142 (defun ange-ftp-get-passwd (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1143 "Given a HOST and USER, return the FTP password, prompting if it was not
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1144 previously set."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1145 (ange-ftp-parse-netrc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1146
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1147 ;; look up password in the hash table first; user might have overriden the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1148 ;; defaults.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1149 (cond ((ange-ftp-lookup-passwd host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1150
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1151 ;; see if default user and password set from the .netrc file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1152 ((and (stringp ange-ftp-default-user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1153 ange-ftp-default-password
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1154 (string-equal user ange-ftp-default-user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1155 ange-ftp-default-password)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1156
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1157 ;; anonymous ftp password is handled specially since there is an
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1158 ;; unwritten rule about how that is used on the Internet.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1159 ((and (or (string-equal user "anonymous")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1160 (string-equal user "ftp"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1161 ange-ftp-generate-anonymous-password)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1162 (if (stringp ange-ftp-generate-anonymous-password)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1163 ange-ftp-generate-anonymous-password
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1164 (concat (user-login-name) "@" (system-name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1165
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1166 ;; see if same user has logged in to other hosts; if so then prompt
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1167 ;; with the password that was used there.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1168 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1169 (let* ((other (ange-ftp-get-host-with-passwd user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1170 (passwd (if other
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1171
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1172 ;; found another machine with the same user.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1173 ;; Try that account.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1174 (ange-ftp-read-passwd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1175 (format "passwd for %s@%s (same as %s@%s): "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1176 user host user other)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1177 (ange-ftp-lookup-passwd other user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1178
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1179 ;; I give up. Ask the user for the password.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1180 (ange-ftp-read-passwd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1181 (format "Password for %s@%s: " user host)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1182 (ange-ftp-set-passwd host user passwd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1183 passwd))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1184
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1185 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1186 ;;;; Account support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1187 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1188
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1189 ;; Account passwords must be either specified in the .netrc file, or set
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1190 ;; manually by calling ange-ftp-set-account. For the moment, ange-ftp doesn't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1191 ;; check to see whether the FTP process is actually prompting for an account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1192 ;; password.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1193
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1194 (defun ange-ftp-set-account (host user account)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1195 "For a given HOST and USER, set or change the associated ACCOUNT password."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1196 (interactive (list (read-string "Host: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1197 (read-string "User: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1198 (ange-ftp-read-passwd "Account password: ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1199 (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1200 account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1201 ange-ftp-account-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1202
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1203 (defun ange-ftp-get-account (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1204 "Given a HOST and USER, return the FTP account."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1205 (ange-ftp-parse-netrc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1206 (or (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1207 ange-ftp-account-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1208 (and (stringp ange-ftp-default-user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1209 (string-equal user ange-ftp-default-user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1210 ange-ftp-default-account)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1211
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1212 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1213 ;;;; ~/.netrc support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1214 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1215
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1216 (defun ange-ftp-chase-symlinks (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1217 "Return the filename that FILENAME references, following all symbolic links."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1218 (let (temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1219 (while (setq temp (ange-ftp-real-file-symlink-p file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1220 (setq file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1221 (if (file-name-absolute-p temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1222 temp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1223 (concat (file-name-directory file) temp)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1224 file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1225
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1226 (defun ange-ftp-parse-netrc-token (token limit)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1227 "Move along current line looking for the value of the TOKEN. Valid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1228 separators between TOKEN and its value are commas and whitespace.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1229 Second arg LIMIT is a limit for the search."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1230 (if (search-forward token limit t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1231 (let (beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1232 (skip-chars-forward ", \t\r\n" limit)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1233 (if (eq (following-char) ?\") ;quoted token value
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1234 (progn (forward-char 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1235 (setq beg (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1236 (skip-chars-forward "^\"" limit)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1237 (forward-char 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1238 (buffer-substring beg (1- (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1239 (setq beg (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1240 (skip-chars-forward "^, \t\r\n" limit)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1241 (buffer-substring beg (point))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1242
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1243 (defun ange-ftp-parse-netrc-group ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1244 "Extract the values for the tokens \`machine\', \`login\', \`password\'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1245 and \`account\' in the current buffer. If successful, record the information
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1246 found."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1247 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1248 (let ((start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1249 (end (progn (re-search-forward "machine\\|default"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1250 (point-max) 'end 2) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1251 machine login password account)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1252 (goto-char start)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1253 (setq machine (ange-ftp-parse-netrc-token "machine" end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1254 login (ange-ftp-parse-netrc-token "login" end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1255 password (ange-ftp-parse-netrc-token "password" end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1256 account (ange-ftp-parse-netrc-token "account" end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1257 (if (and machine login)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1258 ;; found a `machine` token.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1259 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1260 (ange-ftp-set-user machine login)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1261 (ange-ftp-set-passwd machine login password)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1262 (and account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1263 (ange-ftp-set-account machine login account)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1264 (goto-char start)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1265 (if (search-forward "default" end t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1266 ;; found a `default' token
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1267 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1268 (setq login (ange-ftp-parse-netrc-token "login" end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1269 password (ange-ftp-parse-netrc-token "password" end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1270 account (ange-ftp-parse-netrc-token "account" end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1271 (and login
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1272 (setq ange-ftp-default-user login))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1273 (and password
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1274 (setq ange-ftp-default-password password))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1275 (and account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1276 (setq ange-ftp-default-account account)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1277 (goto-char end)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1278
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1279 (defun ange-ftp-parse-netrc ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1280 "If ~/.netrc file exists and has the correct permissions then extract the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1281 \`machine\', \`login\', \`password\' and \`account\' information from within."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1282
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1283 ;; We set this before actually doing it to avoid the possibility
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1284 ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1285 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1286 (let* ((file (ange-ftp-chase-symlinks
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1287 (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1288 (attr (ange-ftp-real-file-attributes file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1289 (if (and attr ; file exists.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1290 (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1291 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1292 (if (or ange-ftp-disable-netrc-security-check
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1293 (and (eq (nth 2 attr) (user-uid)) ; Same uids.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1294 (string-match ".r..------" (nth 8 attr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1295 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1296 ;; we are cheating a bit here. I'm trying to do the equivalent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1297 ;; of find-file on the .netrc file, but then nuke it afterwards.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1298 ;; with the bit of logic below we should be able to have
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1299 ;; encrypted .netrc files.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1300 (set-buffer (generate-new-buffer "*ftp-.netrc*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1301 (ange-ftp-real-insert-file-contents file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1302 (setq buffer-file-name file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1303 (setq default-directory (file-name-directory file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1304 (normal-mode t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1305 (mapcar 'funcall find-file-hooks)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1306 (setq buffer-file-name nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1307 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1308 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1309 (ange-ftp-parse-netrc-group))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1310 (kill-buffer (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1311 (ange-ftp-message "%s either not owned by you or badly protected."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1312 ange-ftp-netrc-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1313 (sit-for 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1314 (setq ange-ftp-netrc-modtime (nth 5 attr))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1315
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1316 (defun ange-ftp-generate-root-prefixes ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1317 "Return a list of prefixes of the form 'user@host:' to be used when
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1318 completion is done in the root directory."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1319 (ange-ftp-parse-netrc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1320 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1321 (let (res)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1322 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1323 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1324 (lambda (key value)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1325 (if (string-match "^[^/]*\\(/\\).*$" key)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1326 (let ((host (substring key 0 (match-beginning 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1327 (user (substring key (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1328 (setq res (cons (list (concat user "@" host ":"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1329 res))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1330 ange-ftp-passwd-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1331 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1332 (function (lambda (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1333 (setq res (cons (list (concat host ":"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1334 res))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1335 ange-ftp-user-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1336 ;; (or res (list nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1337 res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1338 )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1339
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1340 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1341 ;;;; Remote pathname syntax support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1342 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1343
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1344 (defmacro ange-ftp-ftp-path-component (n ns path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1345 "Extract the Nth ftp path component from NS."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1346 (` (let ((elt (nth (, n) (, ns))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1347 (if (match-beginning elt)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1348 (substring (, path) (match-beginning elt) (match-end elt))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1349
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1350 (defvar ange-ftp-ftp-path-arg "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1351 (defvar ange-ftp-ftp-path-res nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1352
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1353 (defun ange-ftp-ftp-path (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1354 "Parse PATH according to ange-ftp-path-format (which see).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1355 Returns a list (HOST USER PATH), or nil if PATH does not match the format."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1356 (if (string-equal path ange-ftp-ftp-path-arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1357 ange-ftp-ftp-path-res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1358 (setq ange-ftp-ftp-path-arg path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1359 ange-ftp-ftp-path-res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1360 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1361 (if (string-match (car ange-ftp-path-format) path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1362 (let* ((ns (cdr ange-ftp-path-format))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1363 (host (ange-ftp-ftp-path-component 0 ns path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1364 (user (ange-ftp-ftp-path-component 1 ns path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1365 (path (ange-ftp-ftp-path-component 2 ns path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1366 (if (zerop (length user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1367 (setq user (ange-ftp-get-user host)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1368 (list host user path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1369 nil)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1370
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1371 (defun ange-ftp-replace-path-component (fullpath path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1372 "Take a FULLPATH that matches according to ange-ftp-path-format and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1373 replace the path component with PATH."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1374 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1375 (if (string-match (car ange-ftp-path-format) fullpath)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1376 (let* ((ns (cdr ange-ftp-path-format))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1377 (elt (nth 2 ns)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1378 (concat (substring fullpath 0 (match-beginning elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1379 path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1380 (substring fullpath (match-end elt)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1381
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1382 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1383 ;;;; Miscellaneous utils.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1384 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1385
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1386 (setq ange-ftp-tmp-keymap (make-sparse-keymap))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1387 (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1388
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1389 (defun ange-ftp-repaint-minibuffer ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1390 "Gross hack to set minibuf_message = 0, so that the contents of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1391 minibuffer will show."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1392 (if (eq (selected-window) (minibuffer-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1393 (if (string-match "XEmacs" emacs-version)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1394 (message nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1395 ;; v18 GNU Emacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1396 (let ((unread-command-char ?\C-m)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1397 (enable-recursive-minibuffers t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1398 (read-from-minibuffer "" nil ange-ftp-tmp-keymap nil)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1399
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1400 (defun ange-ftp-ftp-process-buffer (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1401 "Return the name of the buffer that collects output from the ftp process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1402 connected to the given HOST and USER pair."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1403 (concat "*ftp " user "@" host "*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1404
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1405 (defun ange-ftp-error (host user msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1406 "Display the last chunk of output from the ftp process for the given HOST
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1407 USER pair, and signal an error including MSG in the text."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1408 (let ((cur (selected-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1409 (pop-up-windows t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1410 (pop-to-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1411 (get-buffer-create
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1412 (ange-ftp-ftp-process-buffer host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1413 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1414 (select-window cur))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1415 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1416
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1417 (defun ange-ftp-set-buffer-mode ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1418 "Set the correct modes for the current buffer if it is visiting a remote
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1419 file."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1420 (if (and (stringp buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1421 (ange-ftp-ftp-path buffer-file-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1422 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1423 (auto-save-mode ange-ftp-auto-save)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1424 (make-variable-buffer-local 'revert-buffer-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1425 (setq revert-buffer-function 'ange-ftp-revert-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1426
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1427 (defun ange-ftp-kill-ftp-process (buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1428 "If the BUFFER's visited filename or default-directory is an ftp filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1429 then kill the related ftp process."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1430 (interactive "bKill FTP process associated with buffer: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1431 (if (null buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1432 (setq buffer (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1433 (let ((file (or (buffer-file-name) default-directory)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1434 (if file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1435 (let ((parsed (ange-ftp-ftp-path (expand-file-name file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1436 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1437 (let ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1438 (user (nth 1 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1439 (kill-buffer (ange-ftp-ftp-process-buffer host user))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1440
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1441 (defun ange-ftp-quote-string (string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1442 "Quote any characters in STRING that may confuse the ftp process."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1443 (apply (function concat)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1444 (mapcar (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1445 (lambda (char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1446 (if (or (<= char ? )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1447 (> char ?\~)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1448 (= char ?\")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1449 (= char ?\\))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1450 (vector ?\\ char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1451 (vector char))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1452 string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1453
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1454 (defun ange-ftp-barf-if-not-directory (directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1455 (or (file-directory-p directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1456 (signal 'file-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1457 (list "Opening directory"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1458 (if (file-exists-p directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1459 "not a directory"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1460 "no such file or directory")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1461 directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1462
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1463 ;;;; ------------------------------------------------------------
4
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1464 ;;;; Remote file name syntax support.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1465 ;;;; ------------------------------------------------------------
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1466 (defvar ange-ftp-name-format
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1467 '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1468 "*Format of a fully expanded remote file name.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1469 This is a list of the form \(REGEXP HOST USER NAME\),
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1470 where REGEXP is a regular expression matching
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1471 the full remote name, and HOST, USER, and NAME are the numbers of
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1472 parenthesized expressions in REGEXP for the components (in that order).")
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1473
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1474 (defun ange-ftp-real-load (&rest args)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1475 (ange-ftp-run-real-handler 'load args))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1476
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1477 (defmacro ange-ftp-ftp-name-component (n ns name)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1478 "Extract the Nth ftp file name component from NS."
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1479 (` (let ((elt (nth (, n) (, ns))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1480 (if (match-beginning elt)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1481 (substring (, name) (match-beginning elt) (match-end elt))))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1482
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1483 (defvar ange-ftp-ftp-name-arg "")
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1484 (defvar ange-ftp-ftp-name-res nil)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1485
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1486 ;; Parse NAME according to `ange-ftp-name-format' (which see).
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1487 ;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1488 (defun ange-ftp-ftp-name (name)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1489 (if (string-equal name ange-ftp-ftp-name-arg)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1490 ange-ftp-ftp-name-res
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1491 (setq ange-ftp-ftp-name-arg name
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1492 ange-ftp-ftp-name-res
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1493 (save-match-data
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1494 (if (posix-string-match (car ange-ftp-name-format) name)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1495 (let* ((ns (cdr ange-ftp-name-format))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1496 (host (ange-ftp-ftp-name-component 0 ns name))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1497 (user (ange-ftp-ftp-name-component 1 ns name))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1498 (name (ange-ftp-ftp-name-component 2 ns name)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1499 (if (zerop (length user))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1500 (setq user (ange-ftp-get-user host)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1501 (list host user name))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1502 nil)))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1503
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1504 ;; Take a FULLNAME that matches according to ange-ftp-name-format and
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1505 ;; replace the name component with NAME.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1506 (defun ange-ftp-replace-name-component (fullname name)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1507 (save-match-data
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1508 (if (posix-string-match (car ange-ftp-name-format) fullname)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1509 (let* ((ns (cdr ange-ftp-name-format))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1510 (elt (nth 2 ns)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1511 (concat (substring fullname 0 (match-beginning elt))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1512 name
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1513 (substring fullname (match-end elt)))))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1514
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1515 (defun ange-ftp-file-local-copy (file)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1516 (let* ((fn1 (expand-file-name file))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1517 (pa1 (ange-ftp-ftp-name fn1)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1518 (if pa1
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1519 (let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1520 (ange-ftp-copy-file-internal fn1 tmp1 t nil
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1521 (format "Getting %s" fn1))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1522 tmp1))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1523
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1524 (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1525 (if (ange-ftp-ftp-name file)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1526 (let ((tryfiles (if nosuffix
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1527 (list file)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1528 (list (concat file ".elc") (concat file ".el") file)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1529 copy)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1530 (while (and tryfiles (not copy))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1531 (condition-case error
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1532 (setq copy (ange-ftp-file-local-copy (car tryfiles)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1533 (ftp-error nil))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1534 (setq tryfiles (cdr tryfiles)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1535 (if copy
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1536 (unwind-protect
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1537 (funcall 'load copy noerror nomessage nosuffix)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1538 (delete-file copy))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1539 (or noerror
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1540 (signal 'file-error (list "Cannot open load file" file)))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1541 (ange-ftp-real-load file noerror nomessage nosuffix)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1542 (put 'load 'ange-ftp 'ange-ftp-load)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1543
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
1544 ;;;; ------------------------------------------------------------
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1545 ;;;; FTP process filter support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1546 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1547
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1548 (defun ange-ftp-process-handle-line (line proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1549 "Look at the given LINE from the ftp process PROC. Try to catagorize it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1550 into one of four categories: good, skip, fatal, or unknown."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1551 (cond ((string-match ange-ftp-xfer-size-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1552 (setq ange-ftp-xfer-size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1553 (ash (string-to-int (substring line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1554 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1555 (match-end 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1556 -10)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1557 ((string-match ange-ftp-skip-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1558 (setq ange-ftp-process-multi-skip nil) ;; XEmacs patch (Bob Weiner)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1559 t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1560 ((string-match ange-ftp-good-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1561 (setq ange-ftp-process-busy nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1562 ange-ftp-process-result t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1563 ange-ftp-process-result-line line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1564 ((string-match ange-ftp-fatal-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1565 (delete-process proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1566 (setq ange-ftp-process-busy nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1567 ange-ftp-process-result-line line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1568 ((string-match ange-ftp-multi-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1569 (setq ange-ftp-process-multi-skip t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1570 (ange-ftp-process-multi-skip
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1571 t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1572 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1573 (setq ange-ftp-process-busy nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1574 ange-ftp-process-result-line line))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1575
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1576 (defun ange-ftp-process-log-string (proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1577 "For a given PROCESS, log the given STRING at the end of its
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1578 associated buffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1579 (let ((old-buffer (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1580 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1581 (let (moving)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1582 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1583 (setq moving (= (point) (process-mark proc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1584 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1585 ;; Insert the text, moving the process-marker.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1586 (goto-char (process-mark proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1587 (insert str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1588 (set-marker (process-mark proc) (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1589 (if moving (goto-char (process-mark proc))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1590 (set-buffer old-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1591
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1592 (defun ange-ftp-set-xfer-size (host user bytes)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1593 "Set the size of the next FTP transfer in bytes."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1594 (let ((proc (ange-ftp-get-process host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1595 (if proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1596 (let ((buf (process-buffer proc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1597 (if buf
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1598 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1599 (set-buffer buf)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1600 (setq ange-ftp-xfer-size (ash bytes -10))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1601
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1602 (defun ange-ftp-process-handle-hash (str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1603 "Remove hash marks from STRING and display count so far."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1604 (setq str (concat (substring str 0 (match-beginning 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1605 (substring str (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1606 ange-ftp-hash-mark-count (+ (- (match-end 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1607 (match-beginning 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1608 ange-ftp-hash-mark-count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1609 (and ange-ftp-process-msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1610 ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1611 (not (eq (selected-window) (minibuffer-window)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1612 (not (boundp 'search-message)) ;screws up isearch otherwise
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1613 (not cursor-in-echo-area) ;screws up y-or-n-p otherwise
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1614 (let ((kbytes (ash (* ange-ftp-hash-mark-unit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1615 ange-ftp-hash-mark-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1616 -6)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1617 (if (zerop ange-ftp-xfer-size)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1618 (ange-ftp-lazy-message "%s...%dk" ange-ftp-process-msg kbytes)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1619 (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1620 ;; cut out the redisplay of identical %-age messages.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1621 (if (not (eq percent ange-ftp-last-percent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1622 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1623 (setq ange-ftp-last-percent percent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1624 (ange-ftp-lazy-message "%s...%d%%"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1625 ange-ftp-process-msg percent)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1626 str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1627
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1628 (defun ange-ftp-call-cont (cont result line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1629 "Call the function specified by CONT. CONT can be either a function or a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1630 list of a function and some args. The first two parameters passed to the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1631 function will be RESULT and LINE. The remaining args will be taken from CONT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1632 if a list was passed."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1633 (if cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1634 (if (and (listp cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1635 (not (eq (car cont) 'lambda)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1636 (apply (car cont) result line (cdr cont))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1637 (funcall cont result line))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1638
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1639 (defun ange-ftp-process-filter (proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1640 "Build up a complete line of output from the ftp PROCESS and pass it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1641 on to ange-ftp-process-handle-line to deal with."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1642 (let ((buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1643 (old-buffer (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1644
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1645 ;; see if the buffer is still around... it could have been deleted.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1646 (if (buffer-name buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1647 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1648 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1649 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1650
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1651 ;; handle hash mark printing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1652 (and ange-ftp-hash-mark-unit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1653 ange-ftp-process-busy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1654 (string-match "^#+$" str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1655 (setq str (ange-ftp-process-handle-hash str)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1656 (ange-ftp-process-log-string proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1657 (if ange-ftp-process-busy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1658 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1659 (setq ange-ftp-process-string (concat ange-ftp-process-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1660 str))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1661
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1662 ;; if we gave an empty password to the USER command earlier
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1663 ;; then we should send a null password now.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1664 (if (string-match "Password: *$" ange-ftp-process-string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1665 (send-string proc "\n"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1666 (while (and ange-ftp-process-busy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1667 (string-match "\n" ange-ftp-process-string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1668 (let ((line (substring ange-ftp-process-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1669 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1670 (match-beginning 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1671 (setq ange-ftp-process-string (substring ange-ftp-process-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1672 (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1673 (while (string-match "^ftp> *" line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1674 (setq line (substring line (match-end 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1675 (ange-ftp-process-handle-line line proc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1676
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1677 ;; has the ftp client finished? if so then do some clean-up
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1678 ;; actions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1679 (if (not ange-ftp-process-busy)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1680 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1681 ;; reset the xfer size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1682 (setq ange-ftp-xfer-size 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1683
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1684 ;; issue the "done" message since we've finished.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1685 (if (and ange-ftp-process-msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1686 ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1687 ange-ftp-process-result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1688 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1689 (ange-ftp-message "%s...done" ange-ftp-process-msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1690 (ange-ftp-repaint-minibuffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1691 (setq ange-ftp-process-msg nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1692
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1693 ;; is there a continuation we should be calling? if so,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1694 ;; we'd better call it, making sure we only call it once.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1695 (if ange-ftp-process-continue
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1696 (let ((cont ange-ftp-process-continue))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1697 (setq ange-ftp-process-continue nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1698 (ange-ftp-call-cont cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1699 ange-ftp-process-result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1700 ange-ftp-process-result-line))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1701 (set-buffer old-buffer)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1702
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1703 (defun ange-ftp-process-sentinel (proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1704 "When ftp process changes state, nuke all file-entries in cache."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1705 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1706 (let ((name (process-name proc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1707 (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1708 (let ((user (substring name (match-beginning 1) (match-end 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1709 (host (substring name (match-beginning 2) (match-end 2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1710 (ange-ftp-wipe-file-entries host user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1711 (setq ange-ftp-ls-cache-file nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1712
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1713 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1714 ;;;; Gateway support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1715 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1716
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1717 (defun ange-ftp-use-gateway-p (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1718 "Returns whether to access this host via a normal (non-smart) gateway."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1719 ;; yes, I know that I could simplify the following expression, but it is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1720 ;; clearer (to me at least) this way.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1721 (and (not ange-ftp-smart-gateway)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1722 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1723 (not (string-match ange-ftp-local-host-regexp host)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1724
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1725 (defun ange-ftp-use-smart-gateway-p (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1726 "Returns whether to access this host via a smart gateway."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1727 (and ange-ftp-smart-gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1728 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1729 (not (string-match ange-ftp-local-host-regexp host)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1730
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1731
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1732 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1733 ;;; Temporary file location and deletion...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1734 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1735
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1736 (defvar ange-ftp-tmp-name-files ())
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1737 (defvar ange-ftp-tmp-name-hashtable (ange-ftp-make-hashtable 10))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1738 (defvar ange-ftp-pid nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1739
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1740 (defun ange-ftp-get-pid ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1741 "Half-hearted attempt to get the current process's id."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1742 (setq ange-ftp-pid (substring (make-temp-name "") 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1743
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1744 (defun ange-ftp-make-tmp-name (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1745 "This routine will return the name of a new file."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1746 (let* ((template (if (ange-ftp-use-gateway-p host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1747 ange-ftp-gateway-tmp-name-template
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1748 ange-ftp-tmp-name-template))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1749 (pid (or ange-ftp-pid (ange-ftp-get-pid)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1750 (start ?a)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1751 file entry)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1752 (while
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1753 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1754 (setq file (format "%s%c%s" template start pid))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1755 (setq entry (intern file ange-ftp-tmp-name-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1756 (or (memq entry ange-ftp-tmp-name-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1757 (ange-ftp-real-file-exists-p file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1758 (if (> (setq start (1+ start)) ?z)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1759 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1760 (setq template (concat template "X"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1761 (setq start ?a))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1762 (setq ange-ftp-tmp-name-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1763 (cons entry ange-ftp-tmp-name-files))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1764 file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1765
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1766 (defun ange-ftp-del-tmp-name (temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1767 (setq ange-ftp-tmp-name-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1768 (delq (intern temp ange-ftp-tmp-name-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1769 ange-ftp-tmp-name-files))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1770 (condition-case ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1771 (ange-ftp-real-delete-file temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1772 (error nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1773
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1774 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1775 ;;;; Interactive gateway program support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1776 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1777
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1778 (defvar ange-ftp-gwp-running t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1779 (defvar ange-ftp-gwp-status nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1780
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1781 (defun ange-ftp-gwp-sentinel (proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1782 (setq ange-ftp-gwp-running nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1783
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1784 (defun ange-ftp-gwp-filter (proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1785 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1786 (ange-ftp-process-log-string proc str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1787 (cond ((string-match "login: *$" str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1788 (send-string proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1789 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1790 (let ((ange-ftp-default-user t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1791 (ange-ftp-get-user ange-ftp-gateway-host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1792 "\n")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1793 ((string-match "Password: *$" str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1794 (send-string proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1795 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1796 (ange-ftp-get-passwd ange-ftp-gateway-host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1797 (ange-ftp-get-user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1798 ange-ftp-gateway-host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1799 "\n")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1800 ((string-match ange-ftp-gateway-fatal-msgs str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1801 (delete-process proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1802 (setq ange-ftp-gwp-running nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1803 ((string-match ange-ftp-gateway-prompt-pattern str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1804 (setq ange-ftp-gwp-running nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1805 ange-ftp-gwp-status t)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1806
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1807 (defun ange-ftp-gwp-start (host user name args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1808 "Login to the gateway machine and fire up an ftp process."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1809 (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1810 (proc (start-process name name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1811 ange-ftp-gateway-program
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1812 ange-ftp-gateway-host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1813 (ftp (mapconcat (function identity) args " ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1814 (process-kill-without-query proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1815 (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1816 (set-process-filter proc (function ange-ftp-gwp-filter))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1817 (set-marker (process-mark proc) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1818 (setq ange-ftp-gwp-running t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1819 ange-ftp-gwp-status nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1820 (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1821 (while ange-ftp-gwp-running ;perform login sequence
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1822 (accept-process-output proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1823 (if (not ange-ftp-gwp-status)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1824 (ange-ftp-error host user "unable to login to gateway"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1825 (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1826 (setq ange-ftp-gwp-running t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1827 ange-ftp-gwp-status nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1828 (process-send-string proc ange-ftp-gateway-setup-term-command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1829 (while ange-ftp-gwp-running ;zap ^M's and double echoing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1830 (accept-process-output proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1831 (if (not ange-ftp-gwp-status)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1832 (ange-ftp-error host user "unable to set terminal modes on gateway"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1833 (setq ange-ftp-gwp-running t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1834 ange-ftp-gwp-status nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1835 (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1836 proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1837
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1838 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1839 ;;;; Support for sending commands to the ftp process.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1840 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1841
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1842 (defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1843 "Low-level routine to send the given ftp CMD to the ftp PROCESS.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1844 MSG is an optional message to output before and after the command.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1845 If CONT is non-NIL then it is either a function or a list of function and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1846 some arguments. The function will be called when the ftp command has completed.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1847 If CONT is NIL then this routine will return \( RESULT . LINE \) where RESULT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1848 is whether the command was successful, and LINE is the line from the FTP
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1849 process that caused the command to complete.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1850 If NOWAIT is given then the routine will return immediately the command has
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1851 been queued with no result. CONT will still be called, however."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1852 (if (memq (process-status proc) '(run open))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1853 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1854 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1855 (while ange-ftp-process-busy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1856 (accept-process-output))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1857 (setq ange-ftp-process-string ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1858 ange-ftp-process-result-line ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1859 ange-ftp-process-busy t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1860 ange-ftp-process-result nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1861 ange-ftp-process-multi-skip nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1862 ange-ftp-process-msg msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1863 ange-ftp-process-continue cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1864 ange-ftp-hash-mark-count 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1865 ange-ftp-last-percent -1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1866 cmd (concat cmd "\n"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1867 (and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1868 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1869 ; (move-marker last-input-start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1870 ;; don't insert the password into the buffer on the USER command.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1871 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1872 (if (string-match "^user \"[^\"]*\"" cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1873 (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1874 (insert cmd)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1875 ; (move-marker last-input-end (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1876 (send-string proc cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1877 (set-marker (process-mark proc) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1878 (if nowait
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1879 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1880 ;; hang around for command to complete
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1881 (while ange-ftp-process-busy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1882 (accept-process-output proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1883 (if cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1884 nil ;cont has already been called
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1885 (cons ange-ftp-process-result ange-ftp-process-result-line))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1886
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1887 (defun ange-ftp-nslookup-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1888 "Attempt to resolve the given HOSTNAME using nslookup if possible."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1889 (interactive "sHost: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1890 (if ange-ftp-nslookup-program
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1891 (let ((proc (start-process " *nslookup*" " *nslookup*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1892 ange-ftp-nslookup-program host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1893 (res host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1894 (process-kill-without-query proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1895 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1896 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1897 (while (memq (process-status proc) '(run open))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1898 (accept-process-output proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1899 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1900 (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1901 (setq res (buffer-substring (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1902 (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1903 (kill-buffer (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1904 res)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1905 host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1906
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1907 (defun ange-ftp-start-process (host user name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1908 "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1909 If HOST is only ftp-able through a gateway machine then spawn a shell
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1910 on the gateway machine to do the ftp instead."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1911 (let* ((use-gateway (ange-ftp-use-gateway-p host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1912 (ftp-prog (if use-gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1913 ange-ftp-gateway-ftp-program-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1914 ange-ftp-ftp-program-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1915 (args (append (list ftp-prog) ange-ftp-ftp-program-args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1916 (saved-term-var (getenv "TERM"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1917 proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1918 ;; fix problems in losing Linux FTP's, which like to output
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1919 ;; ESC sequences to highlight the ftp prompt, which messes things up
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1920 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1921 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1922 (setenv "TERM" "dumb")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1923 (if use-gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1924 (if ange-ftp-gateway-program-interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1925 (setq proc (ange-ftp-gwp-start host user name args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1926 (setq proc (apply 'start-process name name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1927 (append (list ange-ftp-gateway-program
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1928 ange-ftp-gateway-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1929 args))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1930 (setq proc (apply 'start-process name name args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1931 (process-kill-without-query proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1932 (set-process-sentinel proc (function ange-ftp-process-sentinel))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1933 (set-process-filter proc (function ange-ftp-process-filter)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1934 (setenv "TERM" saved-term-var))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1935 ;; jwz: turn on shell mode after setting the proc filter for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1936 ;; benefit of shell-font.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1937 (require 'shell)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1938 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1939 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1940 (ange-ftp-shell-mode))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1941 (accept-process-output proc) ;wait for ftp startup message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1942 proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1943
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1944 (defun ange-ftp-smart-login (host user pass account proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1945 "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1946 PROC is the FTP-client's process. This routine uses the smart-gateway
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1947 host specified in ``ange-ftp-gateway-host''."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1948 (let ((result (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1949 proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1950 (format "open %s %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1951 (ange-ftp-nslookup-host ange-ftp-gateway-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1952 ange-ftp-smart-gateway-port)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1953 (format "Opening FTP connection to %s via %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1954 host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1955 ange-ftp-gateway-host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1956 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1957 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1958 (concat "OPEN request failed: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1959 (cdr result))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1960 (setq result (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1961 proc (format "user \"%s\"@%s %s %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1962 user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1963 (ange-ftp-nslookup-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1964 pass
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1965 account)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1966 (format "Logging in as user %s@%s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1967 user host)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1968 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1969 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1970 (ange-ftp-set-passwd host user nil) ; reset password
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1971 (ange-ftp-set-account host user nil) ; reset account
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1972 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1973 (concat "USER request failed: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1974 (cdr result)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1975
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1976 (defun ange-ftp-normal-login (host user pass account proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1977 "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1978 PROC is the process to the FTP-client."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1979 (let ((result (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1980 proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1981 (format "open %s" (ange-ftp-nslookup-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1982 (format "Opening FTP connection to %s" host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1983 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1984 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1985 (concat "OPEN request failed: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1986 (cdr result))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1987 (setq result (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1988 proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1989 (format "user \"%s\" %s %s" user pass account)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1990 (format "Logging in as user %s@%s" user host)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1991 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1992 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1993 (ange-ftp-set-passwd host user nil) ;reset password.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1994 (ange-ftp-set-account host user nil) ;reset account.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1995 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1996 (concat "USER request failed: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1997 (cdr result)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1998
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1999 (defvar ange-ftp-hash-mark-msgs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2000 "[hH]ash mark [^0-9]*\\([0-9]+\\)"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2001 "*Regexp matching the FTP client's output upon doing a HASH command.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2002
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2003 (defun ange-ftp-guess-hash-mark-size (proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2004 (if ange-ftp-send-hash
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2005 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2006 (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2007 (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2008 (result (car status))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2009 (line (cdr status)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2010 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2011 (if (string-match ange-ftp-hash-mark-msgs line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2012 (let ((size (string-to-int
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2013 (substring line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2014 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2015 (match-end 1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2016 (setq ange-ftp-ascii-hash-mark-size size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2017 ange-ftp-hash-mark-unit (ash size -4))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2018
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2019 ;; if a default value for this is set, use that value.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2020 (or ange-ftp-binary-hash-mark-size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2021 (setq ange-ftp-binary-hash-mark-size size)))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2022
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2023 (defun ange-ftp-get-process (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2024 "Return the process object for a FTP process connected to HOST and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2025 logged in as USER. Create a new process if needed."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2026 (let* ((name (ange-ftp-ftp-process-buffer host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2027 (proc (get-process name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2028 (if (and proc (memq (process-status proc) '(run open)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2029 proc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2030 (let ((pass (ange-ftp-quote-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2031 (ange-ftp-get-passwd host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2032 (account (ange-ftp-quote-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2033 (ange-ftp-get-account host user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2034 ;; grab a suitable process.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2035 (setq proc (ange-ftp-start-process host user name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2036
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2037 ;; login to FTP server.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2038 (if (ange-ftp-use-smart-gateway-p host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2039 (ange-ftp-smart-login host user pass account proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2040 (ange-ftp-normal-login host user pass account proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2041
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2042 ;; Tell client to send back hash-marks as progress. It isn't usually
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2043 ;; fatal if this command fails.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2044 (ange-ftp-guess-hash-mark-size proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2045
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2046 ;; Guess at the host type.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2047 (ange-ftp-guess-host-type host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2048
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2049 ;; Run any user-specified hooks. Note that proc, host and user are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2050 ;; dynamically bound at this point.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2051 (run-hooks 'ange-ftp-process-startup-hook))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2052 proc)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2053
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2054 ;; Variables for caching host and host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2055 (defvar ange-ftp-host-cache nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2056 (defvar ange-ftp-host-type-cache nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2057
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2058 ;; If ange-ftp-host-type is called with the optional user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2059 ;; argument, it will attempt to guess the host type by connecting
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2060 ;; as user, if necessary. For efficiency, I have tried to give this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2061 ;; optional second argument only when necessary. Have I missed any calls
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2062 ;; to ange-ftp-host-type where it should have been supplied?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2063
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2064 (defun ange-ftp-host-type (host &optional user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2065 "Return a symbol which represents the type of the HOST given.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2066 If the optional argument USER is given, attempts to guess the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2067 host-type by logging in as USER."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2068 (if (eq host ange-ftp-host-cache)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2069 ange-ftp-host-type-cache
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2070 ;; Trigger an ftp connection, in case we need to guess at the host type.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2071 (if (and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2072 ange-ftp-host-type-cache
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2073 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2074 ange-ftp-host-type-cache
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2075 (cond ((ange-ftp-dumb-unix-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2076 'dumb-unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2077 ((and (fboundp 'ange-ftp-vos-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2078 (ange-ftp-vos-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2079 'vos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2080 ((and (fboundp 'ange-ftp-vms-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2081 (ange-ftp-vms-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2082 'vms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2083 ((and (fboundp 'ange-ftp-mts-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2084 (ange-ftp-mts-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2085 'mts)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2086 ((and (fboundp 'ange-ftp-cms-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2087 (ange-ftp-cms-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2088 'cms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2089 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2090 'unix))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2091
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2092 ;; It would be nice to abstract the functions ange-ftp-TYPE-host and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2093 ;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2094 ;; without sacrificing speed. Also, having separate variables
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2095 ;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2096 ;; set an alist to indicate that a host is of a given type. Even with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2097 ;; automatic host type recognition, setting a regexp is still a good idea
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2098 ;; (for efficiency) if you log into a particular non-UNIX host frequently.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2099
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2100 (defvar ange-ftp-fix-path-func-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2101 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2102 which can change a UNIX path into a path more suitable for a host of type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2103 TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2104
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2105 (defvar ange-ftp-fix-dir-path-func-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2106 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2107 which can change UNIX directory path into a directory path more suitable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2108 for a host of type TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2109
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2110 ;; *** Perhaps the sense of this variable should be inverted, since there
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2111 ;; *** is only 1 host type that can take ls-style listing options.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2112 (defvar ange-ftp-dumb-host-types '(dumb-unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2113 "List of host types that can't take UNIX ls-style listing options.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2114
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2115 (defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2116 "Find an ftp process connected to HOST logged in as USER and send it CMD.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2117 MSG is an optional status message to be output before and after issuing the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2118 command.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2119 See the documentation for ange-ftp-raw-send-cmd for a description of CONT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2120 and NOWAIT."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2121 ;; Handle conversion to remote pathname syntax and remote ls option
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2122 ;; capability.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2123 (let ((cmd0 (car cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2124 (cmd1 (nth 1 cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2125 cmd2 cmd3 host-type fix-pathname-func)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2126
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2127 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2128
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2129 ;; pwd case (We don't care what host-type.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2130 ((null cmd1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2131
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2132 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2133 ((progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2134 (setq cmd2 (nth 2 cmd)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2135 host-type (ange-ftp-host-type host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2136 ;; This will trigger an FTP login, if one doesn't exist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2137 (eq cmd0 'dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2138 (setq cmd1 (funcall
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2139 (or (cdr (assq host-type ange-ftp-fix-dir-path-func-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2140 'identity)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2141 cmd1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2142 cmd3 (nth 3 cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2143 ;; Need to deal with the HP-UX ftp bug. This should also allow
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2144 ;; us to resolve symlinks to directories on SysV machines. (Sebastian will
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2145 ;; be happy.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2146 (and (eq host-type 'unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2147 (string-match "/$" cmd1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2148 (not (string-match "R" cmd3))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2149 (setq cmd1 (concat cmd1 ".")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2150 ;; If the remote ls can take switches, put them in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2151 (or (memq host-type ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2152 (setq cmd0 'ls
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2153 cmd1 (format "\"%s %s\"" cmd3 cmd1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2154
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2155 ;; First argument is the remote pathname
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2156 ((progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2157 (setq fix-pathname-func (or (cdr (assq host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2158 ange-ftp-fix-path-func-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2159 'identity))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2160 (memq cmd0 '(get delete mkdir rmdir cd)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2161 (setq cmd1 (funcall fix-pathname-func cmd1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2162
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2163 ;; Second argument is the remote pathname
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2164 ((memq cmd0 '(append put chmod))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2165 (setq cmd2 (funcall fix-pathname-func cmd2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2166
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2167 ;; Both arguments are remote pathnames
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2168 ((eq cmd0 'rename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2169 (setq cmd1 (funcall fix-pathname-func cmd1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2170 cmd2 (funcall fix-pathname-func cmd2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2171
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2172 ;; Turn the command into one long string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2173 (setq cmd0 (symbol-name cmd0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2174 (setq cmd (concat cmd0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2175 (and cmd1 (concat " " cmd1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2176 (and cmd2 (concat " " cmd2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2177
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2178 ;; Actually send the resulting command.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2179 (let (afsc-result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2180 afsc-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2181 (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2182 (ange-ftp-get-process host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2183 cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2184 msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2185 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2186 (function (lambda (result line host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2187 cmd msg cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2188 (or cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2189 (setq afsc-result result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2190 afsc-line line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2191 (if result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2192 (ange-ftp-call-cont cont result line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2193 (ange-ftp-raw-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2194 (ange-ftp-get-process host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2195 cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2196 msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2197 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2198 (function (lambda (result line cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2199 (or cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2200 (setq afsc-result result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2201 afsc-line line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2202 (ange-ftp-call-cont cont result line)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2203 cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2204 nowait))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2205 host user cmd msg cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2206 nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2207
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2208 (if nowait
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2209 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2210 (if cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2211 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2212 (cons afsc-result afsc-line))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2213
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2214 ;; It might be nice to message users about the host type identified,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2215 ;; but there is so much other messaging going on, it would not be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2216 ;; seen. No point in slowing things down just so users can read
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2217 ;; a host type message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2218
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2219 (defconst ange-ftp-cms-path-template
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2220 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2221 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2222 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2223 (defconst ange-ftp-vms-path-template
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2224 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2225 (defconst ange-ftp-mts-path-template
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2226 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2227
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2228 (defun ange-ftp-guess-host-type (host user)
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
2229 "Guess at the host type of HOST by doing a pwd, and examining
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2230 the directory syntax."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2231 (let ((host-type (ange-ftp-host-type host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2232 (key (concat host "/" user "/~")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2233 (if (eq host-type 'unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2234 ;; Note that ange-ftp-host-type returns unix as the default value.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2235 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2236 (let* ((result (ange-ftp-get-pwd host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2237 (dir (car result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2238 fix-path-func)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2239 (cond ((null dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2240 (message "Warning! Unable to get home directory")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2241 (sit-for 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2242 (if (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2243 "^450 No current working directory defined$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2244 (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2245
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2246 ;; We'll assume that if pwd bombs with this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2247 ;; error message, then it's CMS.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2248 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2249 (ange-ftp-add-cms-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2250 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2251 ange-ftp-host-type-cache 'cms))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2252
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2253 ;; try for VMS
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2254 ((string-match ange-ftp-vms-path-template dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2255 (ange-ftp-add-vms-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2256 ;; The add-host functions clear the host type cache.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2257 ;; Therefore, need to set the cache afterwards.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2258 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2259 ange-ftp-host-type-cache 'vms))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2260
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2261 ;; try for MTS
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2262 ((string-match ange-ftp-mts-path-template dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2263 (ange-ftp-add-mts-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2264 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2265 ange-ftp-host-type-cache 'mts))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2266
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2267 ;; try for CMS
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2268 ((string-match ange-ftp-cms-path-template dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2269 (ange-ftp-add-cms-host host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2270 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2271 ange-ftp-host-type-cache 'cms))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2272
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2273 ;; assume UN*X
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2274 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2275 (setq ange-ftp-host-cache host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2276 ange-ftp-host-type-cache 'unix)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2277
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2278 ;; Now that we have done a pwd, might as well put it in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2279 ;; the expand-dir hashtable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2280 (setq fix-path-func (cdr (assq ange-ftp-host-type-cache
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2281 ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2282 (if fix-path-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2283 (setq dir (funcall fix-path-func dir 'reverse)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2284 (ange-ftp-put-hash-entry key dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2285 ange-ftp-expand-dir-hashtable))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2286
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2287 ;; In the special case of CMS make sure that know the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2288 ;; expansion of the home minidisk now, because we will
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2289 ;; be doing a lot of cd's.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2290 (if (and (eq host-type 'cms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2291 (not (ange-ftp-hash-entry-exists-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2292 key ange-ftp-expand-dir-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2293 (let ((dir (car (ange-ftp-get-pwd host user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2294 (if dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2295 (ange-ftp-put-hash-entry key (concat "/" dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2296 ange-ftp-expand-dir-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2297 (message "Warning! Unable to get home directory")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2298 (sit-for 1))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2299
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2300
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2301 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2302 ;;;; Simple FTP process shell support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2303 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2304
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2305 (defvar ange-ftp-shell-mode-map nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2306
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2307 (defun ange-ftp-shell-mode ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2308 "Major mode for interacting with an FTP process.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2309 Return at end of buffer sends line as input.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2310 Return not at end copies rest of line to end and sends it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2311
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2312 The following commands imitate the usual Unix interrupt and editing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2313 control characters:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2314 \\{ange-ftp-shell-mode-map}
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2315 Runs ange-ftp-shell-mode-hook if not nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2316 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2317 (let ((proc (get-buffer-process (current-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2318 (kill-all-local-variables)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2319 (shell-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2320 (if (null ange-ftp-shell-mode-map)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2321 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2322 (setq ange-ftp-shell-mode-map (make-sparse-keymap))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2323 (set-keymap-parent ange-ftp-shell-mode-map shell-mode-map)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2324 (set-keymap-name ange-ftp-shell-mode-map 'ange-ftp-shell-mode-map)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2325 (use-local-map ange-ftp-shell-mode-map)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2326 (setq major-mode 'ange-ftp-shell-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2327 (setq mode-name "ange-ftp")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2328 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2329 (set-marker (process-mark proc) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2330 (set (make-local-variable 'ange-ftp-process-string) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2331 (setq ange-ftp-process-string "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2332 (set (make-local-variable 'ange-ftp-process-busy) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2333 (set (make-local-variable 'ange-ftp-process-result) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2334 (set (make-local-variable 'ange-ftp-process-msg) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2335 (set (make-local-variable 'ange-ftp-process-multi-skip) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2336 (set (make-local-variable 'ange-ftp-process-result-line) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2337 (set (make-local-variable 'ange-ftp-process-continue) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2338 (set (make-local-variable 'ange-ftp-hash-mark-count) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2339 (set (make-local-variable 'ange-ftp-binary-hash-mark-size) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2340 (set (make-local-variable 'ange-ftp-ascii-hash-mark-size) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2341 (set (make-local-variable 'ange-ftp-hash-mark-unit) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2342 (set (make-local-variable 'ange-ftp-xfer-size) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2343 (set (make-local-variable 'ange-ftp-last-percent) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2344 (setq ange-ftp-hash-mark-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2345 (setq ange-ftp-xfer-size 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2346 (setq ange-ftp-process-result-line "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2347 (run-hooks 'ange-ftp-shell-mode-hook)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2348
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2349 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2350 ;;;; Remote file and directory listing support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2351 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2352
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2353 (defun ange-ftp-dumb-unix-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2354 "Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2355 to take switch arguments."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2356 (and ange-ftp-dumb-unix-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2357 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2358 (string-match ange-ftp-dumb-unix-host-regexp host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2359
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2360 (defun ange-ftp-add-dumb-unix-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2361 "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2362 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2363 (list (read-string "Host: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2364 (let ((name (or (buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2365 (and (eq major-mode 'dired-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2366 dired-directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2367 (and name (car (ange-ftp-ftp-path name)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2368 (if (not (ange-ftp-dumb-unix-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2369 (setq ange-ftp-dumb-unix-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2370 (concat "^" (regexp-quote host) "$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2371 (and ange-ftp-dumb-unix-host-regexp "\\|")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2372 ange-ftp-dumb-unix-host-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2373 ange-ftp-host-cache nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2374
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2375 (defvar ange-ftp-parse-list-func-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2376 "Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2377 which can parse the output from a DIR listing for a host of type TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2378
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2379 ;; With no-error nil, this function returns:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2380 ;; an error if file is not an ange-ftp-path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2381 ;; (This should never happen.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2382 ;; an error if either the listing is unreadable or there is an ftp error.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2383 ;; the listing (a string), if everything works.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2384 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2385 ;; With no-error t, it returns:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2386 ;; an error if not an ange-ftp-path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2387 ;; error if listing is unreable (most likely caused by a slow connection)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2388 ;; nil if ftp error (this is because although asking to list a nonexistent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2389 ;; directory on a remote unix machine usually (except
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2390 ;; maybe for dumb hosts) returns an ls error, but no
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2391 ;; ftp error, if the same is done on a VMS machine,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2392 ;; an ftp error is returned. Need to trap the error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2393 ;; so we can go on and try to list the parent.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2394 ;; the listing, if everything works.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2395
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2396 (defun ange-ftp-ls (file lsargs parse &optional no-error)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2397 "Return the output of an `DIR' or `ls' command done over ftp.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2398 FILE is the full name of the remote file, LSARGS is any args to pass to the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2399 `ls' command, and PARSE specifies that the output should be parsed and stored
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2400 away in the internal cache."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2401 ;; If parse is t, we assume that file is a directory. i.e. we only parse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2402 ;; full directory listings.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2403 (setq file (ange-ftp-expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2404 (let ((parsed (ange-ftp-ftp-path file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2405 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2406 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2407 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2408 (path (ange-ftp-quote-string (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2409 (key (directory-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2410 (host-type (ange-ftp-host-type host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2411 (dumb (memq host-type ange-ftp-dumb-host-types))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2412 result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2413 temp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2414 lscmd parse-func)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2415 (if (string-equal path "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2416 (setq path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2417 (ange-ftp-real-file-name-as-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2418 (ange-ftp-expand-dir host user "~"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2419 (if (and ange-ftp-ls-cache-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2420 (string-equal key ange-ftp-ls-cache-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2421 ;; Don't care about lsargs for dumb hosts.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2422 (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2423 ange-ftp-ls-cache-res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2424 (setq temp (ange-ftp-make-tmp-name host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2425 (setq lscmd (list 'dir path temp lsargs))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2426 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2427 (if (car (setq result (ange-ftp-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2428 host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2429 user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2430 lscmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2431 (format "Listing %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2432 (ange-ftp-abbreviate-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2433 file)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2434 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2435 (set-buffer (get-buffer-create
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2436 ange-ftp-data-buffer-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2437 (erase-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2438 (if (ange-ftp-real-file-readable-p temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2439 (ange-ftp-real-insert-file-contents temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2440 (sleep-for ange-ftp-retry-time)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2441 ;wait for file to possibly appear
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2442 (if (ange-ftp-real-file-readable-p temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2443 ;; Try again.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2444 (ange-ftp-real-insert-file-contents temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2445 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2446 (format
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2447 "list data file %s not readable"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2448 temp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2449 (if parse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2450 (ange-ftp-set-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2451 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2452 (if (setq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2453 parse-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2454 (cdr (assq host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2455 ange-ftp-parse-list-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2456 (funcall parse-func)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2457 (ange-ftp-parse-dired-listing lsargs))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2458 (setq ange-ftp-ls-cache-file key
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2459 ange-ftp-ls-cache-lsargs lsargs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2460 ; For dumb hosts-types this is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2461 ; meaningless but harmless.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2462 ange-ftp-ls-cache-res (buffer-string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2463 ;; (kill-buffer (current-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2464 ange-ftp-ls-cache-res)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2465 (if no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2466 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2467 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2468 (concat "DIR failed: " (cdr result)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2469 (ange-ftp-del-tmp-name temp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2470 (error "Should never happen. Please report. Bug ref. no.: 1"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2471
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2472 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2473 ;;;; Directory information caching support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2474 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2475
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2476 (defconst ange-ftp-date-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2477 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2478 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2479 "\\|Nov\\|Dec\\) +[0-3]?[0-9] "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2480
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2481 (defvar ange-ftp-add-file-entry-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2482 "Association list of pairs \( TYPE \. FUNC \), where FUNC
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2483 is a function to be used to add a file entry for the OS TYPE. The
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2484 main reason for this alist is to deal with file versions in VMS.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2485
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2486 (defvar ange-ftp-delete-file-entry-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2487 "Association list of pairs \( TYPE \. FUNC \), where FUNC
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2488 is a function to be used to delete a file entry for the OS TYPE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2489 The main reason for this alist is to deal with file versions in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2490 VMS.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2491
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2492 (defun ange-ftp-add-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2493 "Given a PATH, add the file entry for it, if its directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2494 info exists."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2495 (funcall (or (cdr (assq (ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2496 (car (ange-ftp-ftp-path path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2497 ange-ftp-add-file-entry-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2498 'ange-ftp-internal-add-file-entry)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2499 path dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2500 (setq ange-ftp-ls-cache-file nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2501
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2502 (defun ange-ftp-delete-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2503 "Given a PATH, delete the file entry for it, if its directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2504 info exists."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2505 (funcall (or (cdr (assq (ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2506 (car (ange-ftp-ftp-path path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2507 ange-ftp-delete-file-entry-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2508 'ange-ftp-internal-delete-file-entry)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2509 path dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2510 (setq ange-ftp-ls-cache-file nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2511
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2512 (defmacro ange-ftp-parse-filename ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2513 ;;Extract the filename from the current line of a dired-like listing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2514 (` (let ((eol (progn (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2515 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2516 (if (re-search-forward ange-ftp-date-regexp eol t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2517 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2518 (skip-chars-forward " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2519 (skip-chars-forward "^ " eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2520 (skip-chars-forward " " eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2521 ;; We bomb on filenames starting with a space.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2522 (buffer-substring (point) eol))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2523
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2524 ;; This deals with the F switch. Should also do something about
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2525 ;; unquoting names obtained with the SysV b switch and the GNU Q
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2526 ;; switch. See Sebastian's dired-get-filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2527
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2528 (defmacro ange-ftp-ls-parser ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2529 ;; Note that switches is dynamically bound.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2530 ;; Meant to be called by ange-ftp-parse-dired-listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2531 (` (let ((tbl (ange-ftp-make-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2532 (used-F (and (stringp switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2533 (string-match "F" switches)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2534 file-type symlink directory file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2535 (while (setq file (ange-ftp-parse-filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2536 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2537 (skip-chars-forward "\t 0-9")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2538 (setq file-type (following-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2539 directory (eq file-type ?d))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2540 (if (eq file-type ?l)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2541 (if (string-match " -> " file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2542 (setq symlink (substring file (match-end 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2543 file (substring file 0 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2544 ;; Shouldn't happen
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2545 (setq symlink ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2546 (setq symlink nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2547 ;; Only do a costly regexp search if the F switch was used.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2548 (if (and used-F
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2549 (not (string-equal file ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2550 (looking-at
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2551 ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2552 (let ((socket (eq file-type ?s))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2553 (executable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2554 (and (not symlink) ; x bits don't mean a thing for symlinks
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2555 (string-match "[xst]"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2556 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2557 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2558 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2559 (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2560 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2561 (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2562 (match-end 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2563 (buffer-substring
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2564 (match-beginning 3)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2565 (match-end 3)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2566 ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2567 ;; and others don't. (sigh...) Beware, that some Unix's don't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2568 ;; seem to believe in the F-switch
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2569 (if (or (and symlink (string-match "@$" file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2570 (and directory (string-match "/$" file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2571 (and executable (string-match "*$" file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2572 (and socket (string-match "=$" file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2573 (setq file (substring file 0 -1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2574 (ange-ftp-put-hash-entry file (or symlink directory) tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2575 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2576 (ange-ftp-put-hash-entry "." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2577 (ange-ftp-put-hash-entry ".." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2578 tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2579
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2580 ;;; The dl stuff for descriptive listings
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2581
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2582 (defvar ange-ftp-dl-dir-regexp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2583 "Regexp matching directories which are listed in dl format. This regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2584 shouldn't be anchored with a trailing $ so that it will match subdirectories
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2585 as well.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2586
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2587 (defun ange-ftp-add-dl-dir (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2588 "Interactively adds a given directory to ange-ftp-dl-dir-regexp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2589 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2590 (list (read-string "Directory: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2591 (let ((name (or (buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2592 (and (eq major-mode 'dired-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2593 dired-directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2594 (and name (ange-ftp-ftp-path name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2595 (file-name-directory name))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2596 (if (not (and ange-ftp-dl-dir-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2597 (string-match ange-ftp-dl-dir-regexp dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2598 (setq ange-ftp-dl-dir-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2599 (concat "^" (regexp-quote dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2600 (and ange-ftp-dl-dir-regexp "\\|")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2601 ange-ftp-dl-dir-regexp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2602
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2603 (defmacro ange-ftp-dl-parser ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2604 ;; Parse the current buffer, which is assumed to be a descriptive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2605 ;; listing, and return a hashtable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2606 (` (let ((tbl (ange-ftp-make-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2607 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2608 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2609 (buffer-substring (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2610 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2611 (skip-chars-forward "^ /\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2612 (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2613 (eq (following-char) ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2614 tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2615 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2616 (ange-ftp-put-hash-entry "." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2617 (ange-ftp-put-hash-entry ".." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2618 tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2619
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2620 (defun ange-ftp-parse-dired-listing (&optional switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2621 "Parse the current buffer which is assumed to be in a dired-like listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2622 format, and return a hashtable as the result. If the listing is not really
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2623 a listing, then return nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2624 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2625 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2626 ((looking-at "^total [0-9]+$")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2627 (forward-line 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2628 (ange-ftp-ls-parser))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2629 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2630 ;; It's an ls error message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2631 nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2632 ((eobp) ; i.e. (zerop (buffer-size))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2633 ;; This could be one of:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2634 ;; (1) An Ultrix ls error message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2635 ;; (2) A listing with the A switch of an empty directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2636 ;; on a machine which doesn't give a total line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2637 ;; (3) The twilight zone.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2638 ;; We'll assume (1) for now.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2639 nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2640 ((re-search-forward ange-ftp-date-regexp nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2641 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2642 (ange-ftp-ls-parser))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2643 ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2644 ;; It's a dl listing (I hope).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2645 ;; file is bound by the call to ange-ftp-ls
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2646 (ange-ftp-add-dl-dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2647 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2648 (ange-ftp-dl-parser))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2649 (t nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2650
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2651 (defun ange-ftp-set-files (directory files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2652 "For a given DIRECTORY, set or change the associated FILES hashtable."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2653 (and files (ange-ftp-put-hash-entry (file-name-as-directory directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2654 files ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2655
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2656 (defun ange-ftp-get-files (directory &optional no-error)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2657 "Given a given DIRECTORY, return a hashtable of file entries.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2658 This will give an error or return nil, depending on the value of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2659 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2660 (setq directory (file-name-as-directory directory)) ;normalize
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2661 (or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2662 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2663 (and (ange-ftp-ls directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2664 ;; This is an efficiency hack. We try to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2665 ;; anticipate what sort of listing dired
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2666 ;; might want, and cache just such a listing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2667 (if (and (boundp 'dired-actual-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2668 (stringp dired-actual-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2669 ;; We allow the A switch, which lists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2670 ;; all files except "." and "..".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2671 ;; This is OK because we manually
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2672 ;; insert these entries
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2673 ;; in the hash table.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2674 (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2675 "[aA]" dired-actual-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2676 (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2677 "l" dired-actual-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2678 (not (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2679 "R" dired-actual-switches)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2680 dired-actual-switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2681 (if (and (boundp 'dired-listing-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2682 (stringp dired-listing-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2683 (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2684 "[aA]" dired-listing-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2685 (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2686 "l" dired-listing-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2687 (not (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2688 "R" dired-listing-switches)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2689 dired-listing-switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2690 "-al"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2691 t no-error)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2692 (ange-ftp-get-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2693 directory ange-ftp-files-hashtable)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2694
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2695 (defmacro ange-ftp-get-file-part (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2696 "Given PATH, return the file part that can be used for looking up the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2697 file's entry in a hashtable."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2698 (` (let ((file (file-name-nondirectory (, path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2699 (if (string-equal file "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2700 "."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2701 file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2702
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2703 (defmacro ange-ftp-allow-child-lookup (dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2704 "Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2705 allowed to determine if PATH is a sub-directory by listing it directly,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2706 rather than listing its parent directory. This is used for efficiency so
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2707 that a wasted listing is not done:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2708 1. When looking for a .dired file in dired-x.el.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2709 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2710 subdirectory. This is of course an OS dependent judgement."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2711 (` (not
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2712 (let* ((efile (, file)) ; expand once.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2713 (edir (, dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2714 (parsed (ange-ftp-ftp-path edir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2715 (host-type (ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2716 (car parsed))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2717 (or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2718 ;; Deal with dired
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2719 (and (boundp 'dired-local-variables-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2720 (stringp dired-local-variables-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2721 (string-equal dired-local-variables-file efile))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2722 ;; No dots in dir names in vms.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2723 (and (eq host-type 'vms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2724 (string-match "\\." efile))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2725 ;; No subdirs in mts of cms.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2726 (and (memq host-type '(mts cms))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2727 (not (string-equal "/" (nth 2 parsed)))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2728
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2729 (defun ange-ftp-file-entry-p (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2730 "Given PATH, return whether there is a file entry for it."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2731 (let* ((path (directory-file-name path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2732 (dir (file-name-directory path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2733 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2734 (file (ange-ftp-get-file-part path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2735 (if ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2736 (ange-ftp-hash-entry-exists-p file ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2737 (or (and (ange-ftp-allow-child-lookup dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2738 (setq ent (ange-ftp-get-files path t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2739 ;; Try a child lookup. i.e. try to list file as a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2740 ;; subdirectory of dir. This is a good idea because
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2741 ;; we may not have read permission for file's parent. Also,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2742 ;; people tend to work down directory trees anyway. We use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2743 ;; no-error ;; because if file does not exist as a subdir.,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2744 ;; then dumb hosts will give an ftp error. Smart unix hosts
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2745 ;; will simply send back the ls
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2746 ;; error message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2747 (ange-ftp-get-hash-entry "." ent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2748 ;; Child lookup failed. Try the parent. If this bombs,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2749 ;; we are at wits end -- signal an error.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2750 ;; Problem: If this signals an error, the error message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2751 ;; may not have a lot to do with what went wrong.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2752 (ange-ftp-hash-entry-exists-p file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2753 (ange-ftp-get-files dir))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2754
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2755 (defun ange-ftp-get-file-entry (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2756 "Given PATH, return the given file entry which will be either t for a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2757 directory, nil for a normal file, or a string for a symlink. If the file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2758 isn't in the hashtable, this also returns nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2759 (let* ((path (directory-file-name path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2760 (dir (file-name-directory path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2761 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2762 (file (ange-ftp-get-file-part path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2763 (if ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2764 (ange-ftp-get-hash-entry file ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2765 (or (and (ange-ftp-allow-child-lookup dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2766 (setq ent (ange-ftp-get-files path t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2767 (ange-ftp-get-hash-entry "." ent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2768 ;; i.e. it's a directory by child lookup
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2769 (ange-ftp-get-hash-entry file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2770 (ange-ftp-get-files dir))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2771
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2772 (defun ange-ftp-internal-delete-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2773 (if dir-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2774 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2775 (setq path (file-name-as-directory path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2776 (ange-ftp-del-hash-entry path ange-ftp-files-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2777 (setq path (directory-file-name path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2778 ;; Note that file-name-as-directory followed by directory-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2779 ;; serves to canonicalize directory file names to their unix form.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2780 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2781 (let ((files (ange-ftp-get-hash-entry (file-name-directory path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2782 ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2783 (if files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2784 (ange-ftp-del-hash-entry (ange-ftp-get-file-part path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2785 files))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2786
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2787 (defun ange-ftp-internal-add-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2788 (and dir-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2789 (setq path (directory-file-name path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2790 (let ((files (ange-ftp-get-hash-entry (file-name-directory path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2791 ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2792 (if files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2793 (ange-ftp-put-hash-entry (ange-ftp-get-file-part path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2794 dir-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2795 files))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2796
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2797 (defun ange-ftp-wipe-file-entries (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2798 "Replace the file entry information hashtable with one that doesn't have any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2799 entries for the given HOST, USER pair."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2800 (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2801 (ange-ftp-map-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2802 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2803 (lambda (key val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2804 (let ((parsed (ange-ftp-ftp-path key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2805 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2806 (let ((h (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2807 (u (nth 1 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2808 (or (and (equal host h) (equal user u))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2809 (ange-ftp-put-hash-entry key val new-tbl)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2810 ange-ftp-files-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2811 (setq ange-ftp-files-hashtable new-tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2812
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2813 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2814 ;;;; File transfer mode support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2815 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2816
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2817 (defun ange-ftp-set-binary-mode (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2818 "Tell the ftp process for the given HOST & USER to switch to binary mode."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2819 (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2820 (if (not (car result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2821 (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2822 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2823 (set-buffer (process-buffer (ange-ftp-get-process host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2824 (and ange-ftp-binary-hash-mark-size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2825 (setq ange-ftp-hash-mark-unit (ash ange-ftp-binary-hash-mark-size -4)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2826
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2827 (defun ange-ftp-set-ascii-mode (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2828 "Tell the ftp process for the given HOST & USER to switch to ascii mode."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2829 (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2830 (if (not (car result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2831 (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2832 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2833 (set-buffer (process-buffer (ange-ftp-get-process host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2834 (and ange-ftp-ascii-hash-mark-size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2835 (setq ange-ftp-hash-mark-unit (ash ange-ftp-ascii-hash-mark-size -4)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2836
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2837 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2838 ;;; expand-file-name and friends...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2839 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2840
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2841 (defun ange-ftp-cd (host user dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2842 (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2843 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2844 (ange-ftp-error host user (concat "CD failed: " (cdr result))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2845
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2846 (defun ange-ftp-get-pwd (host user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2847 "Attempts to get the current working directory for the given HOST/USER pair.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2848 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2849 and LINE is the relevant success or fail line from the FTP-client."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2850 (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2851 (line (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2852 dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2853 (if (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2854 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2855 (and (or (string-match "\"\\([^\"]*\\)\"" line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2856 (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2857 (setq dir (substring line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2858 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2859 (match-end 1))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2860 (cons dir line)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2861
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2862 (defconst ange-ftp-expand-dir-hashtable (ange-ftp-make-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2863
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2864 (defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2865
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2866 (defun ange-ftp-expand-dir (host user dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2867 "Return the result of doing a PWD in the current FTP session to machine HOST
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2868 logged in as user USER and cd'd to directory DIR."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2869 (let* ((host-type (ange-ftp-host-type host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2870 ;; It is more efficient to call ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2871 ;; before binding res, because ange-ftp-host-type sometimes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2872 ;; adds to the info in the expand-dir-hashtable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2873 (fix-pathname-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2874 (cdr (assq host-type ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2875 (key (concat host "/" user "/" dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2876 (res (ange-ftp-get-hash-entry key ange-ftp-expand-dir-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2877 (or res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2878 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2879 (or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2880 (string-equal user "anonymous")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2881 (string-equal user "ftp")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2882 (not (eq host-type 'unix))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2883 (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2884 "\\|"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2885 ange-ftp-good-msgs))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2886 (result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2887 (list 'get dir "/dev/null")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2888 (format "expanding %s" dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2889 (line (cdr result)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2890 (setq res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2891 (if (string-match ange-ftp-expand-dir-regexp line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2892 (substring line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2893 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2894 (match-end 1))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2895 (or res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2896 (if (string-equal dir "~")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2897 (setq res (car (ange-ftp-get-pwd host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2898 (let ((home (ange-ftp-expand-dir host user "~")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2899 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2900 (and (ange-ftp-cd host user dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2901 (setq res (car (ange-ftp-get-pwd host user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2902 (ange-ftp-cd host user home)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2903 (if res
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2904 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2905 (if fix-pathname-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2906 (setq res (funcall fix-pathname-func res 'reverse)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2907 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2908 key res ange-ftp-expand-dir-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2909 res))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2910
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2911 (defun ange-ftp-canonize-filename (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2912 "Take a string and short-circuit //, /. and /.."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2913 (if (string-match "[^:]+//" n) ;don't upset Apollo users
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2914 (setq n (substring n (1- (match-end 0)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2915 (let ((parsed (ange-ftp-ftp-path n)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2916 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2917 (let ((host (car parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2918 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2919 (path (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2920
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2921 ;; See if remote path is absolute. If so then just expand it and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2922 ;; replace the path component of the overall path.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2923 (cond ((string-match "^/" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2924 path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2925
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2926 ;; Path starts with ~ or ~user. Resolve that part of the path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2927 ;; making it absolute then re-expand it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2928 ((string-match "^~[^/]*" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2929 (let* ((tilda (substring path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2930 (match-beginning 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2931 (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2932 (rest (substring path (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2933 (dir (ange-ftp-expand-dir host user tilda)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2934 (if dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2935 (setq path (concat dir rest))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2936 (error "User \"%s\" is not known"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2937 (substring tilda 1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2938
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2939 ;; relative path. Tack on homedir and re-expand.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2940 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2941 (let ((dir (ange-ftp-expand-dir host user "~")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2942 (if dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2943 (setq path (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2944 (ange-ftp-real-file-name-as-directory dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2945 path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2946 (error "Unable to obtain CWD")))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2947
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2948 (if (not (string-match "^//" path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2949 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2950 (setq path (ange-ftp-real-expand-file-name path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2951
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2952 (if (string-match "^//" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2953 (setq path (substring path 1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2954
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2955 ;; Now substitute the expanded path back into the overall filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2956 (ange-ftp-replace-path-component n path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2957
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2958 ;; non-ange-ftp path. Just expand normally.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2959 (if (eq (string-to-char n) ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2960 (ange-ftp-real-expand-file-name n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2961 (ange-ftp-real-expand-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2962 (ange-ftp-real-file-name-nondirectory n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2963 (ange-ftp-real-file-name-directory n))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2964
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2965 (defun ange-ftp-expand-file-name (name &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2966 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2967 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2968 (if (eq (string-to-char name) ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2969 (while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2970 (setq name (substring name (1- (match-end 0)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2971 ((string-match "/~" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2972 (setq name (substring name (1- (match-end 0))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2973 (cond ((eq (string-to-char name) ?~)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2974 (ange-ftp-real-expand-file-name name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2975 ((eq (string-to-char name) ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2976 (ange-ftp-canonize-filename name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2977 ((zerop (length name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2978 (ange-ftp-canonize-filename (or default default-directory)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2979 ((ange-ftp-canonize-filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2980 (concat (file-name-as-directory (or default default-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2981 name))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2982
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2983 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2984 ;;;; Redefinitions of standard GNU Emacs functions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2985 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2986
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2987 (defvar ange-ftp-file-name-as-directory-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2988 "Association list of \( TYPE \. FUNC \) pairs, where
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2989 FUNC converts a filename to a directory name for the operating
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2990 system TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2991
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2992 (defun ange-ftp-file-name-as-directory (name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2993 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2994 (let ((parsed (ange-ftp-ftp-path name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2995 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2996 (if (string-equal (nth 2 parsed) "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2997 name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2998 (funcall (or (cdr (assq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2999 (ange-ftp-host-type (car parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3000 ange-ftp-file-name-as-directory-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3001 'ange-ftp-real-file-name-as-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3002 name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3003 (ange-ftp-real-file-name-as-directory name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3004
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3005 (defun ange-ftp-file-name-directory (name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3006 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3007 (let ((parsed (ange-ftp-ftp-path name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3008 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3009 (let ((path (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3010 (if (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3011 (string-match "^~[^/]*$" path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3012 name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3013 (ange-ftp-replace-path-component
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3014 name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3015 (ange-ftp-real-file-name-directory path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3016 (ange-ftp-real-file-name-directory name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3017
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3018 (defun ange-ftp-file-name-nondirectory (name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3019 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3020 (let ((parsed (ange-ftp-ftp-path name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3021 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3022 (let ((path (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3023 (if (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3024 (string-match "^~[^/]*$" path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3025 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3026 (ange-ftp-real-file-name-nondirectory path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3027 (ange-ftp-real-file-name-nondirectory name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3028
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3029 (defun ange-ftp-directory-file-name (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3030 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3031 (let ((parsed (ange-ftp-ftp-path dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3032 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3033 (ange-ftp-replace-path-component
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3034 dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3035 (ange-ftp-real-directory-file-name (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3036 (ange-ftp-real-directory-file-name dir))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3037
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3038 (defun ange-ftp-binary-file (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3039 "Returns whether the given FILE is to be considered as a binary file for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3040 ftp transfers."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3041 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3042 (string-match ange-ftp-binary-file-name-regexp file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3043
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3044 (defun ange-ftp-write-region (start end filename &optional append visit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3045 lockname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3046 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3047 (interactive "r\nFWrite region to file: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3048 (setq filename (expand-file-name filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3049 (let ((parsed (ange-ftp-ftp-path filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3050 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3051 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3052 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3053 (path (ange-ftp-quote-string (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3054 (temp (ange-ftp-make-tmp-name host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3055 (binary (ange-ftp-binary-file filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3056 (cmd (if append 'append 'put))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3057 (abbr (ange-ftp-abbreviate-filename filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3058 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3059 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3060 (let ((executing-macro t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3061 (filename (buffer-file-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3062 (mod-p (buffer-modified-p)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3063 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3064 (ange-ftp-real-write-region start end temp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3065 visit lockname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3066 ;; cleanup forms
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3067 (setq buffer-file-name filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3068 (if (fboundp 'compute-buffer-file-truename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3069 (compute-buffer-file-truename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3070 (set-buffer-modified-p mod-p)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3071 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3072 (ange-ftp-set-binary-mode host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3073
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3074 ;; tell the process filter what size the transfer will be.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3075 (let ((attr (file-attributes temp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3076 (if attr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3077 (ange-ftp-set-xfer-size host user (nth 7 attr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3078
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3079 ;; put or append the file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3080 (let ((result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3081 (list cmd temp path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3082 (format "Writing %s" abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3083 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3084 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3085 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3086 "Opening output file"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3087 (format "FTP Error: \"%s\"" (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3088 filename)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3089 (ange-ftp-del-tmp-name temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3090 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3091 (ange-ftp-set-ascii-mode host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3092 (if (eq visit t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3093 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3094 (ange-ftp-set-buffer-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3095 (setq buffer-file-name filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3096 (if (fboundp 'compute-buffer-file-truename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3097 (compute-buffer-file-truename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3098 (set-buffer-modified-p nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3099 (ange-ftp-message "Wrote %s" abbr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3100 (ange-ftp-add-file-entry filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3101 (ange-ftp-real-write-region start end filename append visit lockname))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3102
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3103 (defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3104 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3105 (barf-if-buffer-read-only)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3106 (setq filename (expand-file-name filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3107 (let ((parsed (ange-ftp-ftp-path filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3108 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3109 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3110 (if visit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3111 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3112 (setq buffer-file-name filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3113 (if (fboundp 'compute-buffer-file-truename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3114 (compute-buffer-file-truename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3115 (if (or (file-exists-p filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3116 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3117 (setq ange-ftp-ls-cache-file nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3118 (ange-ftp-del-hash-entry (file-name-directory filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3119 ange-ftp-files-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3120 (file-exists-p filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3121 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3122 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3123 (path (ange-ftp-quote-string (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3124 (temp (ange-ftp-make-tmp-name host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3125 (binary (ange-ftp-binary-file filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3126 (abbr (ange-ftp-abbreviate-filename filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3127 size)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3128 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3129 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3130 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3131 (ange-ftp-set-binary-mode host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3132 (let ((result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3133 (list 'get path temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3134 (format "Retrieving %s" abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3135 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3136 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3137 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3138 "Opening input file"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3139 (format "FTP Error: \"%s\"" (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3140 filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3141 (if (or (ange-ftp-real-file-readable-p temp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3142 (sleep-for ange-ftp-retry-time)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3143 ;; Wait for file to hopefully appear.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3144 (ange-ftp-real-file-readable-p temp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3145 (setq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3146 size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3147 (nth 1 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3148 (if replace ; kludge...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3149 (delete-region (point-min)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3150 (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3151 (ange-ftp-real-insert-file-contents
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3152 temp visit beg end nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3153 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3154 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3155 "Opening input file:"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3156 (format
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3157 "FTP Error: %s not arrived or readable"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3158 filename)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3159 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3160 (ange-ftp-set-ascii-mode host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3161 (ange-ftp-del-tmp-name temp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3162 (if visit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3163 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3164 (setq buffer-file-name filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3165 (if (fboundp 'compute-buffer-file-truename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3166 (compute-buffer-file-truename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3167 (list filename size))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3168 (signal 'file-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3169 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3170 "Opening input file"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3171 filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3172 (ange-ftp-real-insert-file-contents filename visit beg end replace))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3173
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3174 (defun ange-ftp-revert-buffer (arg noconfirm)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3175 "Revert this buffer from a remote file using ftp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3176 (let ((opoint (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3177 (cond ((null buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3178 (error "Buffer does not seem to be associated with any file"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3179 ((or noconfirm
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3180 (yes-or-no-p (format "Revert buffer from file %s? "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3181 buffer-file-name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3182 (let ((buffer-read-only nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3183 ;; Set buffer-file-name to nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3184 ;; so that we don't try to lock the file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3185 (let ((buffer-file-name nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3186 (unlock-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3187 (erase-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3188 (insert-file-contents buffer-file-name t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3189 (goto-char (min opoint (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3190 (after-find-file nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3191 t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3192
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3193 (defun ange-ftp-expand-symlink (file dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3194 (if (file-name-absolute-p file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3195 (ange-ftp-replace-path-component dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3196 (expand-file-name file dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3197
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3198 (defun ange-ftp-file-symlink-p (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3199 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3200 ;; call ange-ftp-expand-file-name rather than the normal
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3201 ;; expand-file-name to stop loops when using a package that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3202 ;; redefines both file-symlink-p and expand-file-name.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3203 (setq file (ange-ftp-expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3204 (if (ange-ftp-ftp-path file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3205 (let ((file-ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3206 (ange-ftp-get-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3207 (ange-ftp-get-file-part file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3208 (ange-ftp-get-files (file-name-directory file)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3209 (if (stringp file-ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3210 (if (file-name-absolute-p file-ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3211 (ange-ftp-replace-path-component
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3212 (file-name-directory file) file-ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3213 file-ent)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3214 (ange-ftp-real-file-symlink-p file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3215
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3216 (defun ange-ftp-file-exists-p (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3217 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3218 (setq path (expand-file-name path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3219 (if (ange-ftp-ftp-path path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3220 (if (ange-ftp-file-entry-p path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3221 (let ((file-ent (ange-ftp-get-file-entry path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3222 (if (stringp file-ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3223 (file-exists-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3224 (ange-ftp-expand-symlink file-ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3225 (file-name-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3226 (directory-file-name path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3227 t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3228 (ange-ftp-real-file-exists-p path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3229
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3230 (defun ange-ftp-file-directory-p (path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3231 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3232 (setq path (expand-file-name path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3233 (if (ange-ftp-ftp-path path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3234 ;; We do a file-name-as-directory on path here because some
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3235 ;; machines (VMS) use a .DIR to indicate the filename associated
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3236 ;; with a directory. This needs to be canonicalized.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3237 (let ((file-ent (ange-ftp-get-file-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3238 (ange-ftp-file-name-as-directory path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3239 (if (stringp file-ent)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3240 (file-directory-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3241 (ange-ftp-expand-symlink file-ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3242 (file-name-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3243 (directory-file-name path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3244 file-ent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3245 (ange-ftp-real-file-directory-p path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3246
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3247 (defun ange-ftp-directory-files (directory &optional full match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3248 &rest v19-args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3249 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3250 (setq directory (expand-file-name directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3251 (if (ange-ftp-ftp-path directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3252 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3253 (ange-ftp-barf-if-not-directory directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3254 (let ((tail (ange-ftp-hash-table-keys
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3255 (ange-ftp-get-files directory)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3256 files f)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3257 (setq directory (file-name-as-directory directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3258 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3259 (while tail
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3260 (setq f (car tail)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3261 tail (cdr tail))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3262 (if (or (not match) (string-match match f))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3263 (setq files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3264 (cons (if full (concat directory f) f) files)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3265 (nreverse files)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3266 (apply 'ange-ftp-real-directory-files directory full match v19-args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3267
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3268 (defun ange-ftp-file-attributes (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3269 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3270 (setq file (expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3271 (let ((parsed (ange-ftp-ftp-path file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3272 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3273 (let ((part (ange-ftp-get-file-part file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3274 (files (ange-ftp-get-files (file-name-directory file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3275 (if (ange-ftp-hash-entry-exists-p part files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3276 (let ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3277 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3278 (path (nth 2 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3279 (dirp (ange-ftp-get-hash-entry part files)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3280 (list (if (and (stringp dirp) (file-name-absolute-p dirp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3281 (ange-ftp-expand-symlink dirp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3282 (file-name-directory file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3283 dirp) ;0 file type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3284 -1 ;1 link count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3285 -1 ;2 uid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3286 -1 ;3 gid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3287 '(0 0) ;4 atime
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3288 '(0 0) ;5 mtime
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3289 '(0 0) ;6 ctime
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3290 -1 ;7 size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3291 (concat (if (stringp dirp) "l" (if dirp "d" "-"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3292 "?????????") ;8 mode
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3293 nil ;9 gid weird
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3294 ;; Hack to give remote files a unique "inode number".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3295 ;; It's actually the sum of the characters in its name.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3296 (apply '+ (nconc (mapcar 'identity host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3297 (mapcar 'identity user)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3298 (mapcar 'identity
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3299 (directory-file-name path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3300 -1 ;11 device number [v19 only]
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3301 ))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3302 (ange-ftp-real-file-attributes file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3303
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3304 (defun ange-ftp-file-writable-p (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3305 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3306 (setq file (expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3307 (if (ange-ftp-ftp-path file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3308 (or (file-exists-p file) ;guess here for speed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3309 (file-directory-p (file-name-directory file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3310 (ange-ftp-real-file-writable-p file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3311
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3312 (defun ange-ftp-file-readable-p (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3313 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3314 (setq file (expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3315 (if (ange-ftp-ftp-path file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3316 (file-exists-p file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3317 (ange-ftp-real-file-readable-p file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3318
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3319 (defun ange-ftp-delete-file (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3320 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3321 (interactive "fDelete file: ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3322 (setq file (expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3323 (let ((parsed (ange-ftp-ftp-path file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3324 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3325 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3326 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3327 (path (ange-ftp-quote-string (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3328 (abbr (ange-ftp-abbreviate-filename file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3329 (result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3330 (list 'delete path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3331 (format "Deleting %s" abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3332 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3333 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3334 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3335 "Removing old name"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3336 (format "FTP Error: \"%s\"" (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3337 file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3338 (ange-ftp-delete-file-entry file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3339 (ange-ftp-real-delete-file file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3340
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3341 (defun ange-ftp-verify-visited-file-modtime (buf)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3342 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3343 (let ((name (buffer-file-name buf)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3344 (if (and (stringp name) (ange-ftp-ftp-path name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3345 t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3346 (ange-ftp-real-verify-visited-file-modtime buf))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3347
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3348 (defun ange-ftp-backup-buffer ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3349 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3350 (let (parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3351 (if (and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3352 (listp ange-ftp-make-backup-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3353 (stringp buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3354 (setq parsed (ange-ftp-ftp-path buffer-file-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3355 (or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3356 (null ange-ftp-make-backup-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3357 (not
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3358 (memq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3359 (ange-ftp-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3360 (car parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3361 ange-ftp-make-backup-files))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3362 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3363 (ange-ftp-real-backup-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3364
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3365 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3366 ;;;; File copying support... totally re-written 6/24/92.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3367 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3368
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3369 (defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3370 (if (file-exists-p absname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3371 (if (not interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3372 (signal 'file-already-exists (list absname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3373 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3374 absname querystring)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3375 (signal 'file-already-exists (list absname))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3376
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3377 ;; async local copy commented out for now since I don't seem to get
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3378 ;; the process sentinel called for some processes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3379 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3380 ;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3381 ;; keep-date cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3382 ;; "Kludge to copy a local file and call a continuation when the copy
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3383 ;; finishes."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3384 ;; ;; check to see if we can overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3385 ;; (if (or (not ok-if-already-exists)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3386 ;; (numberp ok-if-already-exists))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3387 ;; (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3388 ;; (numberp ok-if-already-exists)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3389 ;; (let ((proc (start-process " *copy*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3390 ;; (generate-new-buffer "*copy*")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3391 ;; "cp"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3392 ;; filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3393 ;; newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3394 ;; res)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3395 ;; (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3396 ;; (process-kill-without-query proc)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3397 ;; (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3398 ;; (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3399 ;; (make-variable-buffer-local 'copy-cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3400 ;; (setq copy-cont cont))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3401 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3402 ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3403 ;; (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3404 ;; (set-buffer (process-buffer proc))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3405 ;; (let ((cont copy-cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3406 ;; (result (buffer-string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3407 ;; (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3408 ;; (if (and (string-equal status "finished\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3409 ;; (zerop (length result)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3410 ;; (ange-ftp-call-cont cont t nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3411 ;; (ange-ftp-call-cont cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3412 ;; nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3413 ;; (if (zerop (length result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3414 ;; (substring status 0 -1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3415 ;; (substring result 0 -1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3416 ;; (kill-buffer (current-buffer))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3417
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3418 ;; this is the extended version of ange-ftp-copy-file-internal that works
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3419 ;; asyncronously if asked nicely.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3420 (defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3421 keep-date &optional msg cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3422 (setq filename (expand-file-name filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3423 newname (expand-file-name newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3424
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3425 ;; canonicalize newname if a directory.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3426 (if (file-directory-p newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3427 (setq newname (expand-file-name (file-name-nondirectory filename) newname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3428
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3429 (let ((f-parsed (ange-ftp-ftp-path filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3430 (t-parsed (ange-ftp-ftp-path newname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3431
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3432 ;; local file to local file copy?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3433 (if (and (not f-parsed) (not t-parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3434 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3435 (ange-ftp-real-copy-file filename newname ok-if-already-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3436 keep-date)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3437 (if cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3438 (ange-ftp-call-cont cont t "Copied locally")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3439 ;; one or both files are remote.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3440 (let* ((f-host (and f-parsed (nth 0 f-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3441 (f-user (and f-parsed (nth 1 f-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3442 (f-path (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3443 (f-abbr (ange-ftp-abbreviate-filename filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3444 (t-host (and t-parsed (nth 0 t-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3445 (t-user (and t-parsed (nth 1 t-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3446 (t-path (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3447 (t-abbr (ange-ftp-abbreviate-filename newname filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3448 (binary (or (ange-ftp-binary-file filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3449 (ange-ftp-binary-file newname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3450 temp1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3451 temp2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3452
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3453 ;; check to see if we can overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3454 (if (or (not ok-if-already-exists)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3455 (numberp ok-if-already-exists))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3456 (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3457 (numberp ok-if-already-exists)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3458
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3459 ;; do the copying.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3460 (if f-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3461
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3462 ;; filename was remote.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3463 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3464 (if (or (ange-ftp-use-gateway-p f-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3465 t-parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3466 ;; have to use intermediate file if we are getting via
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3467 ;; gateway machine or we are doing a remote to remote copy.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3468 (setq temp1 (ange-ftp-make-tmp-name f-host)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3469
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3470 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3471 (ange-ftp-set-binary-mode f-host f-user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3472
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3473 (ange-ftp-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3474 f-host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3475 f-user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3476 (list 'get f-path (or temp1 newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3477 (or msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3478 (if (and temp1 t-parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3479 (format "Getting %s" f-abbr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3480 (format "Copying %s to %s" f-abbr t-abbr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3481 (list (function ange-ftp-cf1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3482 filename newname binary msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3483 f-parsed f-host f-user f-path f-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3484 t-parsed t-host t-user t-path t-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3485 temp1 temp2 cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3486 nowait))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3487
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3488 ;; filename wasn't remote. newname must be remote. call the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3489 ;; function which does the remainder of the copying work.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3490 (ange-ftp-cf1 t nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3491 filename newname binary msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3492 f-parsed f-host f-user f-path f-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3493 t-parsed t-host t-user t-path t-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3494 nil nil cont nowait))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3495
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3496 ;; next part of copying routine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3497 (defun ange-ftp-cf1 (result line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3498 filename newname binary msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3499 f-parsed f-host f-user f-path f-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3500 t-parsed t-host t-user t-path t-abbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3501 temp1 temp2 cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3502 (if line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3503 ;; filename must have been remote, and we must have just done a GET.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3504 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3505 (or result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3506 ;; GET failed for some reason. Clean up and get out.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3507 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3508 (and temp1 (ange-ftp-del-tmp-name temp1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3509 (or cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3510 (signal 'ftp-error (list "Opening input file"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3511 (format "FTP Error: \"%s\"" line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3512 filename)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3513 ;; cleanup
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3514 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3515 (ange-ftp-set-ascii-mode f-host f-user))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3516
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3517 (if result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3518 ;; We now have to copy either temp1 or filename to newname.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3519 (if t-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3520
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3521 ;; newname was remote.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3522 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3523 (if (ange-ftp-use-gateway-p t-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3524 (setq temp2 (ange-ftp-make-tmp-name t-host)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3525
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3526 ;; make sure data is moved into the right place for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3527 ;; outgoing transfer. gateway temporary files complicate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3528 ;; things nicely.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3529 (if temp1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3530 (if temp2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3531 (if (string-equal temp1 temp2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3532 (setq temp1 nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3533 (ange-ftp-real-copy-file temp1 temp2 t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3534 (setq temp2 temp1 temp1 nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3535 (if temp2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3536 (ange-ftp-real-copy-file filename temp2 t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3537
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3538 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3539 (ange-ftp-set-binary-mode t-host t-user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3540
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3541 ;; tell the process filter what size the file is.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3542 (let ((attr (file-attributes (or temp2 filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3543 (if attr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3544 (ange-ftp-set-xfer-size t-host t-user (nth 7 attr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3545
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3546 (ange-ftp-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3547 t-host
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3548 t-user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3549 (list 'put (or temp2 filename) t-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3550 (or msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3551 (if (and temp2 f-parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3552 (format "Putting %s" newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3553 (format "Copying %s to %s" f-abbr t-abbr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3554 (list (function ange-ftp-cf2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3555 newname t-host t-user binary temp1 temp2 cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3556 nowait))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3557
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3558 ;; newname wasn't remote.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3559 (ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3560
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3561 ;; first copy failed, tell caller
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3562 (ange-ftp-call-cont cont result line)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3563
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3564 ;; last part of copying routine.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3565 (defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3566 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3567 (if line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3568 ;; result from doing a local to remote copy.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3569 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3570 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3571 (or result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3572 (or cont
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3573 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3574 (list "Opening output file"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3575 (format "FTP Error: \"%s\"" line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3576 newname))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3577
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3578 (ange-ftp-add-file-entry newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3579
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3580 ;; cleanup.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3581 (if binary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3582 (ange-ftp-set-ascii-mode t-host t-user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3583
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3584 ;; newname was local.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3585 (if temp1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3586 (ange-ftp-real-copy-file temp1 newname t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3587
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3588 ;; clean up
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3589 (and temp1 (ange-ftp-del-tmp-name temp1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3590 (and temp2 (ange-ftp-del-tmp-name temp2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3591 (ange-ftp-call-cont cont result line)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3592
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3593 (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3594 keep-date)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3595 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3596 (interactive "fCopy file: \nFCopy %s to file: \np")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3597 (ange-ftp-copy-file-internal filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3598 newname
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3599 ok-if-already-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3600 keep-date
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3601 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3602 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3603 (interactive-p)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3604
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3605 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3606 ;;;; File renaming support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3607 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3608
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3609 (defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3610 binary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3611 "Rename remote file FILE to remote file NEWNAME."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3612 (let ((f-host (nth 0 f-parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3613 (f-user (nth 1 f-parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3614 (t-host (nth 0 t-parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3615 (t-user (nth 1 t-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3616 (if (and (string-equal f-host t-host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3617 (string-equal f-user t-user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3618 (let* ((f-path (ange-ftp-quote-string (nth 2 f-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3619 (t-path (ange-ftp-quote-string (nth 2 t-parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3620 (cmd (list 'rename f-path t-path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3621 (fabbr (ange-ftp-abbreviate-filename filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3622 (nabbr (ange-ftp-abbreviate-filename newname filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3623 (result (ange-ftp-send-cmd f-host f-user cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3624 (format "Renaming %s to %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3625 fabbr
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3626 nabbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3627 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3628 (signal 'ftp-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3629 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3630 "Renaming"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3631 (format "FTP Error: \"%s\"" (cdr result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3632 filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3633 newname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3634 (ange-ftp-add-file-entry newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3635 (ange-ftp-delete-file-entry filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3636 (ange-ftp-copy-file-internal filename newname t nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3637 (delete-file filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3638
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3639 (defun ange-ftp-rename-local-to-remote (filename newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3640 "Rename local FILE to remote file NEWNAME."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3641 (let* ((fabbr (ange-ftp-abbreviate-filename filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3642 (nabbr (ange-ftp-abbreviate-filename newname filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3643 (msg (format "Renaming %s to %s" fabbr nabbr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3644 (ange-ftp-copy-file-internal filename newname t nil msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3645 (let (ange-ftp-process-verbose)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3646 (delete-file filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3647
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3648 (defun ange-ftp-rename-remote-to-local (filename newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3649 "Rename remote file FILE to local file NEWNAME."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3650 (let* ((fabbr (ange-ftp-abbreviate-filename filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3651 (nabbr (ange-ftp-abbreviate-filename newname filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3652 (msg (format "Renaming %s to %s" fabbr nabbr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3653 (ange-ftp-copy-file-internal filename newname t nil msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3654 (let (ange-ftp-process-verbose)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3655 (delete-file filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3656
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3657 (defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3658 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3659 (interactive "fRename file: \nFRename %s to file: \np")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3660 (setq filename (expand-file-name filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3661 (setq newname (expand-file-name newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3662 (let* ((f-parsed (ange-ftp-ftp-path filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3663 (t-parsed (ange-ftp-ftp-path newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3664 (binary (if (or f-parsed t-parsed) (ange-ftp-binary-file filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3665 (if (and (or f-parsed t-parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3666 (or (not ok-if-already-exists)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3667 (numberp ok-if-already-exists)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3668 (ange-ftp-barf-or-query-if-file-exists
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3669 newname
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3670 "rename to it"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3671 (numberp ok-if-already-exists)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3672 (if f-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3673 (if t-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3674 (ange-ftp-rename-remote-to-remote filename newname f-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3675 t-parsed binary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3676 (ange-ftp-rename-remote-to-local filename newname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3677 (if t-parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3678 (ange-ftp-rename-local-to-remote filename newname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3679 (ange-ftp-real-rename-file filename newname ok-if-already-exists)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3680
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3681 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3682 ;;;; Classic Dired support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3683 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3684
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3685 (defvar ange-ftp-dired-host-type nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3686 "The host type associated with a dired buffer. (buffer local)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3687 (make-variable-buffer-local 'ange-ftp-dired-host-type)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3688
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3689 (defun ange-ftp-dired-readin (dirname buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3690 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3691 (let ((file (ange-ftp-abbreviate-filename dirname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3692 (parsed (ange-ftp-ftp-path dirname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3693 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3694 (ange-ftp-message "Reading directory %s..." file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3695 (set-buffer buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3696 (let ((buffer-read-only nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3697 (widen)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3698 (erase-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3699 (setq dirname (expand-file-name dirname))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3700 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3701 (let ((host-type (ange-ftp-host-type (car parsed))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3702 (setq ange-ftp-dired-host-type host-type)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3703 (insert (ange-ftp-ls dirname dired-listing-switches t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3704 (if (ange-ftp-real-file-directory-p dirname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3705 (call-process "ls" nil buffer nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3706 dired-listing-switches dirname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3707 (let ((default-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3708 (ange-ftp-real-file-name-directory dirname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3709 (call-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3710 shell-file-name nil buffer nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3711 "-c" (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3712 "ls " dired-listing-switches " "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3713 (ange-ftp-real-file-name-nondirectory dirname))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3714 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3715 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3716 (insert " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3717 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3718 (goto-char (point-min))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3719 (ange-ftp-message "Reading directory %s...done" file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3720
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3721 (defun ange-ftp-dired-revert (&optional arg noconfirm)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3722 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3723 (if (and dired-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3724 (ange-ftp-ftp-path (expand-file-name dired-directory)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3725 (setq ange-ftp-ls-cache-file nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3726 (ange-ftp-real-dired-revert arg noconfirm))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3727
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3728 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3729 ;;;; Tree Dired support (ange & Sebastian Kremer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3730 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3731
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3732 (defvar ange-ftp-dired-re-exe-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3733 "Association list of regexps \(strings\) which match file lines of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3734 executable files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3735
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3736 (defvar ange-ftp-dired-re-dir-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3737 "Association list of regexps \(strings\) which match file lines of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3738 subdirectories.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3739
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3740 (defvar ange-ftp-dired-insert-headerline-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3741 "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3742 the function to be used by dired to insert the headerline of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3743 the dired buffer.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3744
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3745 (defvar ange-ftp-dired-move-to-filename-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3746 "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3747 the function to be used by dired to move to the beginning of a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3748 filename.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3749
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3750 (defvar ange-ftp-dired-move-to-end-of-filename-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3751 "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3752 the function to be used by dired to move to the end of a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3753 filename.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3754
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3755 (defvar ange-ftp-dired-get-filename-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3756 "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3757 the function to be used by dired to get a filename from the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3758 current line.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3759
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3760 (defvar ange-ftp-dired-between-files-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3761 "Association list of \(TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3762 the function to be used by dired to determine when the point
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3763 is on a line between files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3764
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3765 (defvar ange-ftp-dired-ls-trim-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3766 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3767 a function which trims extraneous lines from a directory listing.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3768
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3769 (defvar ange-ftp-dired-clean-directory-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3770 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3771 a function which cleans out old versions of files in the OS TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3772
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3773 (defvar ange-ftp-dired-flag-backup-files-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3774 "Association list of \( TYPE \. FUNC \) pairs, where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3775 a functions which flags the backup files for deletion in the OS TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3776
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3777 (defvar ange-ftp-dired-backup-diff-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3778 "Association list of \( TYPE \. FUNC \) pairs, where FUNC diffs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3779 a file with its backup. The backup file is determined according to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3780 the OS TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3781
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3782 ;; Could use dired-before-readin-hook here, instead of overloading
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3783 ;; dired-readin. However, if people change this hook after ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3784 ;; is loaded, they'll break things.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3785 ;; Also, why overload dired-readin rather than dired-mode?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3786 ;; Because I don't want to muck up virtual dired (see dired-x.el).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3787
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3788 (defun ange-ftp-tree-dired-readin (dirname buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3789 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3790 (let ((parsed (ange-ftp-ftp-path dirname)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3791 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3792 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3793 (set-buffer buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3794 (setq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3795 (ange-ftp-host-type (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3796 (and ange-ftp-dl-dir-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3797 (eq ange-ftp-dired-host-type 'unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3798 (string-match ange-ftp-dl-dir-regexp dirname)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3799 (setq ange-ftp-dired-host-type 'unix:dl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3800 (let ((eentry (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3801 ange-ftp-dired-re-exe-alist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3802 (dentry (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3803 ange-ftp-dired-re-dir-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3804 (if eentry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3805 (set (make-local-variable 'dired-re-exe) (cdr eentry)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3806 (if dentry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3807 (set (make-local-variable 'dired-re-dir) (cdr dentry)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3808 ;; No switches are sent to dumb hosts, so don't confuse dired.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3809 ;; I hope that dired doesn't get excited if it doesn't see the l
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3810 ;; switch. If it does, then maybe fake things by setting this to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3811 ;; "-Al".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3812 (if (memq ange-ftp-dired-host-type ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3813 (setq dired-actual-switches "-Al"))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3814 (ange-ftp-real-dired-readin dirname buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3815
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3816 (defun ange-ftp-dired-insert-headerline (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3817 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3818 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3819 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3820 ange-ftp-dired-insert-headerline-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3821 'ange-ftp-real-dired-insert-headerline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3822 dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3823
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3824 (defun ange-ftp-dired-move-to-filename (&optional raise-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3825 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3826 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3827 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3828 ange-ftp-dired-move-to-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3829 'ange-ftp-real-dired-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3830 raise-error eol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3831
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3832 (defun ange-ftp-dired-move-to-end-of-filename (&optional no-error)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3833 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3834 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3835 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3836 ange-ftp-dired-move-to-end-of-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3837 'ange-ftp-real-dired-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3838 no-error))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3839
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3840 (defun ange-ftp-dired-get-filename (&optional localp no-error-if-not-filep)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3841 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3842 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3843 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3844 ange-ftp-dired-get-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3845 'ange-ftp-real-dired-get-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3846 localp no-error-if-not-filep))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3847
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3848 (defun ange-ftp-dired-between-files ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3849 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3850 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3851 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3852 ange-ftp-dired-between-files-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3853 'ange-ftp-real-dired-between-files)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3854
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3855 (defvar ange-ftp-bob-version-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3856 "Association list of pairs \( TYPE \. FUNC \), where FUNC is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3857 a function to be used to bob the version number off of a filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3858 in OS TYPE.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3859
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3860 (defun ange-ftp-dired-find-file ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3861 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3862 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3863 (find-file (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3864 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3865 ange-ftp-bob-version-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3866 'identity)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3867 (dired-get-filename))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3868
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3869 ;; Need the following functions for making filenames of compressed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3870 ;; files, because some OS's (unlike UNIX) do not allow a filename to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3871 ;; have two extensions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3872
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3873 (defvar ange-ftp-dired-compress-make-compressed-filename-alist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3874 "Association list of \( TYPE \. FUNC \) pairs, where FUNC converts a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3875 filename to the filename of the associated compressed file.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3876
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3877 ;;; this overwrites dired's `dired-compress-make-compressed-filename'
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3878 (defun ange-ftp-dired-compress-make-compressed-filename (name &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3879 "Converts a filename to the filename of the associated compressed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3880 file. With an optional reverse argument, the reverse conversion is done.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3881
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3882 Modified to work with gzip (GNU zip) files."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3883 (let ((parsed (ange-ftp-ftp-path name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3884 conversion-func)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3885 (if (and parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3886 (setq conversion-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3887 (cdr (assq (ange-ftp-host-type (car parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3888 ange-ftp-dired-compress-make-compressed-filename-alist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3889 (funcall conversion-func name reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3890 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3891
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3892 ;; uncompress...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3893 ;; return `nil' if no match found -- better than nothing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3894 (let (case-fold-search ; case-sensitive search
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3895 (string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3896 (concat "\\.\\(g?z\\|" (regexp-quote dired-gzip-file-extension)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3897 "$\\|Z\\)$")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3898
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3899 (and (string-match string name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3900 (substring name 0 (match-beginning 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3901
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3902 ;; add appropriate extension
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3903 ;; note: it could be that `gz' is not the proper extension for gzip
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3904 (concat name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3905 (if dired-use-gzip-instead-of-compress
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3906 dired-gzip-file-extension ".Z"))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3907
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3908 (defun ange-ftp-dired-clean-directory (keep)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3909 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3910 (interactive "P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3911 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3912 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3913 ange-ftp-dired-clean-directory-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3914 'ange-ftp-real-dired-clean-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3915 keep))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3916
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3917 (defun ange-ftp-dired-backup-diff (&optional switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3918 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3919 (interactive (list (if (fboundp 'diff-read-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3920 (diff-read-switches "Diff with switches: "))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3921 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3922 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3923 ange-ftp-dired-backup-diff-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3924 'ange-ftp-real-dired-backup-diff)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3925 switches))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3926
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3927
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3928 (defun ange-ftp-dired-fixup-subdirs (start file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3929 "Turn each subdir name into a valid ange-ftp filename."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3930
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3931 ;; We haven't indented the listing yet.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3932 ;; Must be careful about filelines ending in a colon: exclude spaces!
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3933 (let ((subdir-regexp "^\\([^ \n\r]+\\)\\(:\\)[\n\r]"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3934 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3935 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3936 (narrow-to-region start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3937 (goto-char start)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3938 (while (re-search-forward subdir-regexp nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3939 (goto-char (match-beginning 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3940 (let ((name (buffer-substring (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3941 (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3942 (delete-region (point) (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3943 (insert (ange-ftp-replace-path-component
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3944 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3945 name))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3946
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3947 (defun ange-ftp-dired-ls (file switches &optional wildcard full-directory-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3948 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3949 (let ((parsed (ange-ftp-ftp-path file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3950 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3951 (let* ((pt (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3952 (path (nth 2 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3953 (host-type (ange-ftp-host-type (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3954 (dumb (memq host-type ange-ftp-dumb-host-types))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3955 trim-func case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3956 ;; Make sure that case-fold-search is nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3957 ;; so that we can look at the switches.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3958 (if wildcard
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3959 (if (not (memq host-type '(unix dumb-unix)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3960 (insert (ange-ftp-ls file switches nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3961 ;; Prevent ls from inserting subdirs, as the subdir header
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3962 ;; line format would be wrong (it would have no "/user@host:"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3963 ;; prefix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3964 (insert (ange-ftp-ls file (concat switches "d") nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3965
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3966 ;; Quoting the path part of the file name seems to be a good
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3967 ;; idea (using dired.el's shell-quote function), but ftpd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3968 ;; always globs ls args before passing them to /bin/ls or even
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3969 ;; doing the ls formatting itself. --> So wildcard characters
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3970 ;; in FILE lose. Sigh...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3971
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3972 ;; When using wildcards, some ftpd's put the whole directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3973 ;; name in front of each filename. Walk down the listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3974 ;; generated and remove this stuff.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3975 (let ((dir (ange-ftp-real-file-name-directory path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3976 (if dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3977 (let ((dirq (regexp-quote dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3978 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3979 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3980 (narrow-to-region pt (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3981 (goto-char pt)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3982 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3983 (if (dired-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3984 (if (re-search-forward dirq nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3985 (replace-match "")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3986 (forward-line 1))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3987
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3988 ;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3989 ;; Big issue here Andy! ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3990 ;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3991 ;; In tree dired V5.245 Sebastian has used the following
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3992 ;; trick to resolve symbolic links to directories. This causes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3993 ;; havoc with ange-ftp, because ange-ftp expands dots, with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3994 ;; expand-file-name before it sends them. This means that this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3995 ;; trick currently fails for remote SysV machines. But worse,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3996 ;; /vms:/DEV:/FOO/. expands to /vms:/DEV:/FOO, which converts
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3997 ;; to DEV:FOO and not DEV:[FOO]. i.e it is only in UNIX that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3998 ;; we can play fast and loose with the difference between
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3999 ;; directory names and their associated filenames.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4000 ;; My temporary fix is to knock Sebastian's dot off.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4001 ;; Maybe things can be made real clever in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4002 ;; the future, so that Sebastian can have his way with remote
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4003 ;; SysV machines.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4004 ;; Sebastian in dired-readin-insert says:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4005
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4006 ;; On SysV derived system, symbolic links to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4007 ;; directories are not resolved, while on BSD
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4008 ;; derived it suffices to let DIRNAME end in slash.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4009 ;; We always let it end in "/." since it does no
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4010 ;; harm on BSD and makes Dired work on such links on
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4011 ;; SysV.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4012
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4013 (if (string-match "/\\.$" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4014 (setq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4015 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4016 (ange-ftp-replace-path-component
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4017 file (substring path 0 -1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4018 (if (string-match "R" switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4019 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4020 (insert (ange-ftp-ls file switches nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4021 ;; fix up the subdirectory names in the recursive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4022 ;; listing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4023 (ange-ftp-dired-fixup-subdirs pt file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4024 (insert
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4025 (ange-ftp-ls file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4026 switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4027 (and (or dumb (string-match "[aA]" switches))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4028 full-directory-p))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4029 (if (and (null full-directory-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4030 (setq trim-func
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4031 (cdr (assq host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4032 ange-ftp-dired-ls-trim-alist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4033 ;; If full-directory-p and wild-card are null, then only one
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4034 ;; line per file must be inserted.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4035 ;; Some OS's (like VMS) insert other crap. Clean it out.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4036 (save-restriction
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4037 (narrow-to-region pt (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4038 (funcall trim-func)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4039 (ange-ftp-real-dired-ls file switches wildcard full-directory-p))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4040
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4041 (defvar ange-ftp-remote-shell-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4042 (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4043 "remsh"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4044 "rsh")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4045 "Remote shell used by ange-ftp.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4046
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4047 (defun ange-ftp-dired-run-shell-command (command &optional in-background)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4048 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4049 (let* ((parsed (ange-ftp-ftp-path default-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4050 (host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4051 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4052 (path (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4053 (if (not parsed)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4054 (ange-ftp-real-dired-run-shell-command command in-background)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4055 (if (> (length path) 0) ; else it's $HOME
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4056 (setq command (concat "cd " path "; " command)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4057 (setq command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4058 (format "%s %s \"%s\"" ; remsh -l USER does not work well
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4059 ; on a hp-ux machine I tried
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4060 ange-ftp-remote-shell-file-name host command))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4061 (ange-ftp-message "Remote command '%s' ..." command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4062 ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4063 ;; would prepend "cd default-directory" --- which bombs because
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4064 ;; default-directory is in ange-ftp syntax for remote path names.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4065 (if in-background
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4066 (comint::background command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4067 (shell-command command)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4068
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4069 (defun ange-ftp-make-directory (dir &optional parents)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4070 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4071 (interactive (list (let ((current-prefix-arg current-prefix-arg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4072 (read-directory-name "Create directory: "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4073 current-prefix-arg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4074 (if (file-exists-p dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4075 (error "Cannot make directory %s: file already exists" dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4076 (let ((parsed (ange-ftp-ftp-path dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4077 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4078 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4079 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4080 ;; Some ftp's on unix machines (at least on Suns)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4081 ;; insist that mkdir take a filename, and not a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4082 ;; directory-name name as an arg. Argh!! This is a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4083 ;; Non-unix machines will probably always insist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4084 ;; that mkdir takes a directory-name as an arg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4085 ;; (as the ftp man page says it should).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4086 (path (ange-ftp-quote-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4087 (if (eq (ange-ftp-host-type host) 'unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4088 (ange-ftp-real-directory-file-name (nth 2 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4089 (ange-ftp-real-file-name-as-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4090 (nth 2 parsed)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4091 (abbr (ange-ftp-abbreviate-filename dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4092 (result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4093 (list 'mkdir path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4094 (format "Making directory %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4095 abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4096 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4097 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4098 (format "Could not make directory %s: %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4099 dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4100 (cdr result))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4101 (ange-ftp-add-file-entry dir t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4102 (ange-ftp-real-make-directory dir parents)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4103
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4104 (defun ange-ftp-remove-directory (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4105 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4106 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4107 (list (expand-file-name (read-file-name "Remove directory: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4108 nil nil 'confirm))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4109 (if (file-directory-p dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4110 (let ((parsed (ange-ftp-ftp-path dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4111 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4112 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4113 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4114 ;; Some ftp's on unix machines (at least on Suns)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4115 ;; insist that rmdir take a filename, and not a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4116 ;; directory-name name as an arg. Argh!! This is a bug.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4117 ;; Non-unix machines will probably always insist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4118 ;; that rmdir takes a directory-name as an arg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4119 ;; (as the ftp man page says it should).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4120 (path (ange-ftp-quote-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4121 (if (eq (ange-ftp-host-type host) 'unix)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4122 (ange-ftp-real-directory-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4123 (nth 2 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4124 (ange-ftp-real-file-name-as-directory
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4125 (nth 2 parsed)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4126 (abbr (ange-ftp-abbreviate-filename dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4127 (result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4128 (list 'rmdir path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4129 (format "Removing directory %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4130 abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4131 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4132 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4133 (format "Could not remove directory %s: %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4134 dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4135 (cdr result))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4136 (ange-ftp-delete-file-entry dir t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4137 (ange-ftp-real-remove-directory dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4138 (error "Not a directory: %s" dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4139
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4140 ;; XEmacs change: This function isn't in the FSF version. Maybe
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4141 ;; because there is no such function as diff-read-args. I can't find
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4142 ;; where there ever _has_ been such a function. If you want this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4143 ;; functionality, write diff-read-args and uncomment this.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4144
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4145 ;;(defun ange-ftp-diff (fn1 fn2 &optional switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4146 ;; "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4147 ;; (interactive (diff-read-args "Diff: " "Diff %s with: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4148 ;; "Diff with switches: "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4149 ;; (or (and (stringp fn1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4150 ;; (stringp fn2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4151 ;; (error "diff: arguments must be strings: %s %s" fn1 fn2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4152 ;; (or switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4153 ;; (setq switches (if (stringp diff-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4154 ;; diff-switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4155 ;; (if (listp diff-switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4156 ;; (mapconcat 'identity diff-switches " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4157 ;; ""))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4158 ;; (let* ((fn1 (expand-file-name fn1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4159 ;; (fn2 (expand-file-name fn2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4160 ;; (pa1 (ange-ftp-ftp-path fn1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4161 ;; (pa2 (ange-ftp-ftp-path fn2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4162 ;; (if (or pa1 pa2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4163 ;; (let* ((tmp1 (and pa1 (ange-ftp-make-tmp-name (car pa1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4164 ;; (tmp2 (and pa2 (ange-ftp-make-tmp-name (car pa2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4165 ;; (bin1 (and pa1 (ange-ftp-binary-file fn1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4166 ;; (bin2 (and pa2 (ange-ftp-binary-file fn2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4167 ;; (dir1 (file-directory-p fn1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4168 ;; (dir2 (file-directory-p fn2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4169 ;; (old-dir default-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4170 ;; (default-directory "/tmp")) ;fool FTP-smart compile.el
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4171 ;; (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4172 ;; (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4173 ;; (if (and dir1 dir2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4174 ;; (error "can't compare remote directories"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4175 ;; (if dir1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4176 ;; (setq fn1 (expand-file-name (file-name-nondirectory fn2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4177 ;; fn1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4178 ;; pa1 (ange-ftp-ftp-path fn1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4179 ;; bin1 (ange-ftp-binary-file fn1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4180 ;; (if dir2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4181 ;; (setq fn2 (expand-file-name (file-name-nondirectory fn1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4182 ;; fn2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4183 ;; pa2 (ange-ftp-ftp-path fn2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4184 ;; bin2 (ange-ftp-binary-file fn2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4185 ;; (and pa1 (ange-ftp-copy-file-internal fn1 tmp1 t nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4186 ;; (format "Getting %s" fn1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4187 ;; (and pa2 (ange-ftp-copy-file-internal fn2 tmp2 t nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4188 ;; (format "Getting %s" fn2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4189 ;; (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4190 ;; (ange-ftp-message "doing diff..."))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4191 ;; (sit-for 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4192 ;; (ange-ftp-real-diff (or tmp1 fn1) (or tmp2 fn2) switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4193 ;; (cond ((boundp 'compilation-process)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4194 ;; (while (and compilation-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4195 ;; (eq (process-status compilation-process)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4196 ;; 'run))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4197 ;; (accept-process-output compilation-process)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4198 ;; ((boundp 'compilation-last-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4199 ;; (while (and compilation-last-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4200 ;; (buffer-name compilation-last-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4201 ;; (get-buffer-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4202 ;; compilation-last-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4203 ;; (eq (process-status
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4204 ;; (get-buffer-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4205 ;; compilation-last-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4206 ;; 'run))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4207 ;; (accept-process-output))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4208 ;; (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4209 ;; (ange-ftp-message "doing diff...done"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4210 ;; (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4211 ;; (set-buffer (get-buffer-create "*compilation*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4212 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4213 ;; ;; replace the default directory that we munged earlier.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4214 ;; (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4215 ;; (if (search-forward (concat "cd " default-directory) nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4216 ;; (replace-match (concat "cd " old-dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4217 ;; (setq default-directory old-dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4218 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4219 ;; ;; massage the diff output, replacing the temporary file-
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4220 ;; ;; names with their original names.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4221 ;; (if tmp1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4222 ;; (let ((q1 (shell-quote tmp1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4223 ;; (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4224 ;; (while (search-forward q1 nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4225 ;; (replace-match fn1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4226 ;; (if tmp2
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4227 ;; (let ((q2 (shell-quote tmp2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4228 ;; (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4229 ;; (while (search-forward q2 nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4230 ;; (replace-match fn2))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4231 ;; (and tmp1 (ange-ftp-del-tmp-name tmp1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4232 ;; (and tmp2 (ange-ftp-del-tmp-name tmp2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4233 ;; (ange-ftp-real-diff fn1 fn2 switches))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4234
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4235 (defun ange-ftp-dired-call-process (program discard &rest arguments)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4236 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4237 ;; PROGRAM is always one of those below in the cond in dired.el.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4238 ;; The ARGUMENTS are (nearly) always files.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4239 (if (ange-ftp-ftp-path default-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4240 ;; Can't use ange-ftp-dired-host-type here because the current
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4241 ;; buffer is *dired-check-process output*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4242 (condition-case oops
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4243 (cond ((equal "compress" program)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4244 (ange-ftp-call-compress arguments))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4245 ((equal "uncompress" program)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4246 (ange-ftp-call-uncompress arguments))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4247 ((equal "chmod" program)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4248 (ange-ftp-call-chmod arguments))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4249 ;; ((equal "chgrp" program))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4250 ;; ((equal dired-chown-program program))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4251 (t (error "Unknown remote command: %s" program)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4252 (ftp-error (insert (format "%s: %s, %s\n"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4253 (nth 1 oops)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4254 (nth 2 oops)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4255 (nth 3 oops))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4256 (error (insert (format "%s\n" (nth 1 oops)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4257 (apply 'call-process program nil (not discard) nil arguments)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4258
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4259
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4260 (defun ange-ftp-call-compress (args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4261 "Perform a compress command on a remote file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4262 Works by taking a copy of the file, compressing it and copying the file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4263 back."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4264 (if (or (not (= (length args) 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4265 (not (string-equal "-f" (car args))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4266 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4267 "ange-ftp-call-compress: missing -f flag and/or missing filename: %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4268 args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4269 (let* ((file (nth 1 args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4270 (parsed (ange-ftp-ftp-path file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4271 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4272 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4273 (abbr (ange-ftp-abbreviate-filename file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4274 (nfile (ange-ftp-dired-compress-make-compressed-filename file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4275 (nabbr (ange-ftp-abbreviate-filename nfile))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4276 (msg1 (format "Getting %s" abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4277 (msg2 (format "Putting %s" nabbr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4278 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4279 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4280 (ange-ftp-copy-file-internal file tmp1 t nil msg1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4281 (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4282 (ange-ftp-message "Compressing %s..." abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4283 (call-process-region (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4284 (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4285 shell-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4286 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4287 t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4288 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4289 "-c"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4290 (format "compress -f -c < %s > %s" tmp1 tmp2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4291 (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4292 (ange-ftp-message "Compressing %s...done" abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4293 (if (zerop (buffer-size))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4294 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4295 (let (ange-ftp-process-verbose)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4296 (delete-file file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4297 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4298 (ange-ftp-del-tmp-name tmp1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4299 (ange-ftp-del-tmp-name tmp2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4300
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4301 (defun ange-ftp-call-uncompress (args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4302 "Perform an uncompress command on a remote file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4303 Works by taking a copy of the file, uncompressing it and copying the file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4304 back."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4305 (if (not (= (length args) 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4306 (error "ange-ftp-call-uncompress: missing filename: %s" args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4307 (let* ((file (car args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4308 (parsed (ange-ftp-ftp-path file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4309 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4310 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4311 (abbr (ange-ftp-abbreviate-filename file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4312 (nfile (ange-ftp-dired-compress-make-compressed-filename file 'reverse))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4313 (nabbr (ange-ftp-abbreviate-filename nfile))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4314 (msg1 (format "Getting %s" abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4315 (msg2 (format "Putting %s" nabbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4316 ;; ;; Cheap hack because of problems with binary file transfers from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4317 ;; ;; VMS hosts.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4318 ;; (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4319 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4320 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4321 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4322 (ange-ftp-copy-file-internal file tmp1 t nil msg1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4323 (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4324 (ange-ftp-message "Uncompressing %s..." abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4325 (call-process-region (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4326 (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4327 shell-file-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4328 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4329 t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4330 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4331 "-c"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4332 (format "uncompress -c < %s > %s" tmp1 tmp2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4333 (and ange-ftp-process-verbose
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4334 (ange-ftp-message "Uncompressing %s...done" abbr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4335 (if (zerop (buffer-size))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4336 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4337 (let (ange-ftp-process-verbose)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4338 (delete-file file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4339 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4340 (ange-ftp-del-tmp-name tmp1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4341 (ange-ftp-del-tmp-name tmp2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4342
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4343 (defvar ange-ftp-remote-shell "rsh"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4344 "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4345
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4346 (defun ange-ftp-call-chmod (args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4347 (if (< (length args) 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4348 (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4349 (let ((mode (car args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4350 (mapcar
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4351 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4352 (lambda (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4353 (setq file (expand-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4354 (let ((parsed (ange-ftp-ftp-path file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4355 (if parsed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4356 (let* ((host (nth 0 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4357 (user (nth 1 parsed))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4358 (path (ange-ftp-quote-string (nth 2 parsed)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4359 (abbr (ange-ftp-abbreviate-filename file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4360 (result (ange-ftp-send-cmd host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4361 (list 'chmod mode path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4362 (format "doing chmod %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4363 abbr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4364 (or (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4365 ;; if FTP server rejects chmod, try rsh chmod instead
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4366 (call-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4367 ange-ftp-remote-shell
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4368 nil t nil host "chmod" mode path)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4369 (cdr args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4370 (setq ange-ftp-ls-cache-file nil)) ;stop confusing dired
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4371
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4372 ;; Need to abstract the way dired computes the names of compressed files.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4373 ;; I feel badly about these two overloads.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4374
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4375 (defun ange-ftp-dired-compress ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4376 ;; Compress current file. Return nil for success, offending filename else.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4377 (let* (buffer-read-only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4378 (from-file (dired-get-filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4379 (to-file (ange-ftp-dired-compress-make-compressed-filename from-file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4380 (cond ((save-excursion (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4381 (looking-at dired-re-sym))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4382 (dired-log (concat "Attempt to compress a symbolic link:\n"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4383 from-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4384 (dired-make-relative from-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4385 ((dired-check-process (concat "Compressing " from-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4386 "compress" "-f" from-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4387 ;; errors from the process are already logged by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4388 ;; dired-check-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4389 (dired-make-relative from-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4390 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4391 (dired-update-file-line to-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4392 nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4393
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4394 (defun ange-ftp-dired-uncompress ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4395 ;; Uncompress current file. Return nil for success,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4396 ;; offending filename else.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4397 (let* (buffer-read-only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4398 (from-file (dired-get-filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4399 (to-file (ange-ftp-dired-compress-make-compressed-filename from-file 'reverse)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4400 (if (dired-check-process (concat "Uncompressing " from-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4401 "uncompress" from-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4402 (dired-make-relative from-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4403 (dired-update-file-line to-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4404 nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4405
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4406 (defun ange-ftp-dired-flag-backup-files (&optional unflag-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4407 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4408 (interactive "P")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4409 (funcall (or (and ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4410 (cdr (assq ange-ftp-dired-host-type
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4411 ange-ftp-dired-flag-backup-files-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4412 'ange-ftp-real-dired-flag-backup-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4413 unflag-p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4414
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4415 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4416 ;;; Noddy support for async copy-file within dired.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4417 ;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4418
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4419 (defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4420 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4421 (dired-handle-overwrite to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4422 (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4423 cont nowait))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4424
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4425 (defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4426 &optional marker-char op1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4427 how-to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4428 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4429 ;; we need to let ange-ftp-dired-create-files know that we indirectly
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4430 ;; called it rather than somebody else.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4431 (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4432 (ange-ftp-real-dired-do-create-files op-symbol file-creator operation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4433 arg marker-char op1 how-to)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4434
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4435 (defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4436 &optional marker-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4437 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4438 (if (and (boundp 'ange-ftp-dired-do-create-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4439 ;; called from ange-ftp-dired-do-create-files?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4440 ange-ftp-dired-do-create-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4441 ;; any files worth copying?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4442 fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4443 ;; we only support async copy-file at the mo.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4444 (eq file-creator 'dired-copy-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4445 ;; it is only worth calling the alternative function for remote files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4446 ;; as we tie ourself in recursive knots otherwise.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4447 (or (ange-ftp-ftp-path (car fn-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4448 ;; we can only call the name constructor for dired-do-create-files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4449 ;; since the one for regexps starts prompting here, there and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4450 ;; everywhere.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4451 (ange-ftp-ftp-path (funcall name-constructor (car fn-list)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4452 ;; use the process-filter driven routine rather than the iterative one.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4453 (ange-ftp-dcf-1 file-creator
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4454 operation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4455 fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4456 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4457 (and (boundp 'target) target) ;dynamically bound
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4458 marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4459 (current-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4460 nil ;overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4461 nil ;overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4462 nil ;failures
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4463 nil ;skipped
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4464 0 ;success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4465 (length fn-list) ;total
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4466 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4467 ;; normal case... use the interative routine... much cheaper.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4468 (ange-ftp-real-dired-create-files file-creator operation fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4469 name-constructor marker-char)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4470
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4471 (defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4472 target marker-char buffer overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4473 overwrite-backup-query failures skipped
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4474 success-count total)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4475 (let ((old-buf (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4476 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4477 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4478 (set-buffer buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4479 (if (null fn-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4480 (ange-ftp-dcf-3 failures operation total skipped
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4481 success-count buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4482
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4483 (let* ((from (car fn-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4484 (to (funcall name-constructor from)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4485 (if (equal to from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4486 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4487 (setq to nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4488 (dired-log "Cannot %s to same file: %s\n"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4489 (downcase operation) from)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4490 (if (not to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4491 (ange-ftp-dcf-1 file-creator
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4492 operation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4493 (cdr fn-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4494 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4495 target
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4496 marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4497 buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4498 overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4499 overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4500 failures
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4501 (cons (dired-make-relative from) skipped)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4502 success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4503 total)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4504 (let* ((overwrite (file-exists-p to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4505 (overwrite-confirmed ; for dired-handle-overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4506 (and overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4507 (let ((help-form '(format "\
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4508 Type SPC or `y' to overwrite file `%s',
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4509 DEL or `n' to skip to next,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4510 ESC or `q' to not overwrite any of the remaining files,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4511 `!' to overwrite all remaining files with no more questions." to)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4512 (dired-query 'overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4513 "Overwrite `%s'?" to))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4514 ;; must determine if FROM is marked before file-creator
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4515 ;; gets a chance to delete it (in case of a move).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4516 (actual-marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4517 (cond ((integerp marker-char) marker-char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4518 (marker-char (dired-file-marker from)) ; slow
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4519 (t nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4520 (condition-case err
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4521 (funcall file-creator from to overwrite-confirmed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4522 (list (function ange-ftp-dcf-2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4523 nil ;err
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4524 file-creator operation fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4525 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4526 target
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4527 marker-char actual-marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4528 buffer to from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4529 overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4530 overwrite-confirmed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4531 overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4532 overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4533 failures skipped success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4534 total)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4535 t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4536 (file-error ; FILE-CREATOR aborted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4537 (ange-ftp-dcf-2 nil ;result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4538 nil ;line
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4539 err
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4540 file-creator operation fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4541 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4542 target
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4543 marker-char actual-marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4544 buffer to from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4545 overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4546 overwrite-confirmed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4547 overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4548 overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4549 failures skipped success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4550 total))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4551 (set-buffer old-buf))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4552
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4553 (defun ange-ftp-dcf-2 (result line err
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4554 file-creator operation fn-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4555 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4556 target
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4557 marker-char actual-marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4558 buffer to from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4559 overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4560 overwrite-confirmed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4561 overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4562 overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4563 failures skipped success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4564 total)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4565 (let ((old-buf (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4566 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4567 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4568 (set-buffer buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4569 (if (or err (not result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4570 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4571 (setq failures (cons (dired-make-relative from) failures))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4572 (dired-log "%s `%s' to `%s' failed:\n%s\n"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4573 operation from to (or err line)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4574 (if overwrite
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4575 ;; If we get here, file-creator hasn't been aborted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4576 ;; and the old entry (if any) has to be deleted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4577 ;; before adding the new entry.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4578 (dired-remove-file to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4579 (setq success-count (1+ success-count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4580 (message "%s: %d of %d" operation success-count total)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4581 (dired-add-file to actual-marker-char))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4582
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4583 (ange-ftp-dcf-1 file-creator operation (cdr fn-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4584 name-constructor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4585 target
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4586 marker-char
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4587 buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4588 overwrite-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4589 overwrite-backup-query
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4590 failures skipped success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4591 total))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4592 (set-buffer old-buf))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4593
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4594 (defun ange-ftp-dcf-3 (failures operation total skipped success-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4595 buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4596 (let ((old-buf (current-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4597 (unwind-protect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4598 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4599 (set-buffer buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4600 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4601 (failures
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4602 (dired-log-summary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4603 (message "%s failed for %d of %d file%s %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4604 operation (length failures) total
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4605 (dired-plural-s total) failures)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4606 (skipped
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4607 (dired-log-summary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4608 (message "%s: %d of %d file%s skipped %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4609 operation (length skipped) total
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4610 (dired-plural-s total) skipped)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4611 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4612 (message "%s: %s file%s."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4613 operation success-count (dired-plural-s success-count))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4614 (dired-move-to-filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4615 (set-buffer old-buf))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4616
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4617 ;;;; -----------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4618 ;;;; Unix Descriptive Listing (dl) Support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4619 ;;;; -----------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4620
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4621 (defconst ange-ftp-dired-dl-re-dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4622 "^. [^ /]+/[ \n]"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4623 "Regular expression to use to search for dl directories.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4624
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4625 (or (assq 'unix:dl ange-ftp-dired-re-dir-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4626 (setq ange-ftp-dired-re-dir-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4627 (cons (cons 'unix:dl ange-ftp-dired-dl-re-dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4628 ange-ftp-dired-re-dir-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4629
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4630 (defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4631 "In dired, move to the first character of the filename on this line."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4632 ;; This is the Unix dl version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4633 (or eol (setq eol (progn (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4634 (let (case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4635 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4636 (if (looking-at ". [^ ]+ +\\([0-9]+\\|-\\|=\\) ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4637 (goto-char (+ (point) 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4638 (if raise-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4639 (error "No file on this line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4640 nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4641
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4642 (or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4643 (setq ange-ftp-dired-move-to-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4644 (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4645 ange-ftp-dired-move-to-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4646
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4647 (defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4648 ;; Assumes point is at beginning of filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4649 ;; So, it should be called only after (dired-move-to-filename t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4650 ;; On failure, signals an error or returns nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4651 ;; This is the Unix dl version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4652 (let ((opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4653 case-fold-search hidden)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4654 (or eol (setq eol (save-excursion (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4655 (setq hidden (and selective-display
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4656 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4657 (search-forward "\r" eol t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4658 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4659 (if no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4660 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4661 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4662 (substitute-command-keys
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4663 "File line is hidden, type \\[dired-hide-subdir] to unhide")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4664 (skip-chars-forward "^ /" eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4665 (if (eq opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4666 (if no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4667 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4668 (error "No file on this line"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4669 (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4670
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4671 (or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4672 (setq ange-ftp-dired-move-to-end-of-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4673 (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4674 ange-ftp-dired-move-to-end-of-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4675
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4676 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4677 ;;;; File name completion support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4678 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4679
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4680 (defun ange-ftp-file-entry-active-p (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4681 "If the file entry is a symlink, returns whether the file pointed to exists.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4682 Note that DIR is dynamically bound."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4683 (let ((val (get sym 'val)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4684 (or (not (stringp val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4685 (file-exists-p (ange-ftp-expand-symlink val dir)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4686
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4687 (defun ange-ftp-file-entry-not-ignored-p (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4688 "If the file entry is not a directory (nor a symlink pointing to a directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4689 returns whether the file (or file pointed to by the symlink) is ignored
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4690 by completion-ignored-extensions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4691 Note that DIR and COMPLETION-IGNORED-PATTERN are dynamically bound."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4692 (let ((val (get sym 'val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4693 (symname (symbol-name sym)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4694 (if (stringp val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4695 (let ((file (ange-ftp-expand-symlink val dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4696 (or (file-directory-p file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4697 (and (file-exists-p file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4698 (not (string-match completion-ignored-pattern
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4699 symname)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4700 (or val ; is a directory name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4701 (not (string-match completion-ignored-pattern symname))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4702
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4703 (defun ange-ftp-file-name-all-completions (file dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4704 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4705 (setq dir (expand-file-name dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4706 (if (ange-ftp-ftp-path dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4707 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4708 (ange-ftp-barf-if-not-directory dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4709 (setq dir (ange-ftp-real-file-name-as-directory dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4710 (let* ((tbl (ange-ftp-get-files dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4711 (completions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4712 (all-completions file tbl
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4713 (function ange-ftp-file-entry-active-p))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4714
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4715 ;; see whether each matching file is a directory or not...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4716 (mapcar
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4717 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4718 (lambda (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4719 (let ((ent (ange-ftp-get-hash-entry file tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4720 (if (and ent
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4721 (or (not (stringp ent))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4722 (file-directory-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4723 (ange-ftp-expand-symlink ent dir))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4724 (concat file "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4725 file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4726 completions)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4727
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4728 (if (string-equal "/" dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4729 (nconc (all-completions file (ange-ftp-generate-root-prefixes))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4730 (ange-ftp-real-file-name-all-completions file dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4731 (ange-ftp-real-file-name-all-completions file dir))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4732
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4733 (defun ange-ftp-file-name-completion (file dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4734 "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4735 (setq dir (expand-file-name dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4736 (if (ange-ftp-ftp-path dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4737 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4738 (ange-ftp-barf-if-not-directory dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4739 (if (equal file "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4740 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4741 (setq dir (ange-ftp-real-file-name-as-directory dir)) ;real?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4742 (let* ((tbl (ange-ftp-get-files dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4743 (completion-ignored-pattern
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4744 (mapconcat (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4745 (lambda (s) (if (stringp s)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4746 (concat (regexp-quote s) "$")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4747 "/"))) ; / never in filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4748 completion-ignored-extensions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4749 "\\|")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4750 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4751 (or (ange-ftp-file-name-completion-1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4752 file tbl dir (function ange-ftp-file-entry-not-ignored-p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4753 (ange-ftp-file-name-completion-1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4754 file tbl dir (function ange-ftp-file-entry-active-p)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4755 (if (string-equal "/" dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4756 (try-completion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4757 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4758 (nconc (ange-ftp-generate-root-prefixes)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4759 (mapcar 'list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4760 (ange-ftp-real-file-name-all-completions file "/"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4761 (ange-ftp-real-file-name-completion file dir))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4762
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4763
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4764 (defun ange-ftp-file-name-completion-1 (file tbl dir predicate)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4765 "Internal subroutine for ange-ftp-file-name-completion. Do not call this."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4766 (let ((bestmatch (try-completion file tbl predicate)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4767 (if bestmatch
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4768 (if (eq bestmatch t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4769 (if (file-directory-p (expand-file-name file dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4770 (concat file "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4771 t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4772 (if (and (eq (try-completion bestmatch tbl predicate) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4773 (file-directory-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4774 (expand-file-name bestmatch dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4775 (concat bestmatch "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4776 bestmatch)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4777
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4778 (defun ange-ftp-quote-filename (file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4779 "Quote `$' as `$$' in FILE to get it past function `substitute-in-file-name.'"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4780 (let ((pos 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4781 (while (setq pos (string-match "\\$" file pos))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4782 (setq file (concat (substring file 0 pos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4783 "$";; precede by escape character (also a $)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4784 (substring file pos))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4785 ;; add 2 instead 1 since another $ was inserted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4786 pos (+ 2 pos)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4787 file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4788
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4789 ;; (defun ange-ftp-read-file-name-internal (string dir action)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4790 ;; "Documented as original."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4791 ;; (let (name realdir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4792 ;; (if (eq action 'lambda)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4793 ;; (if (> (length string) 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4794 ;; (file-exists-p (substitute-in-file-name string)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4795 ;; (if (zerop (length string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4796 ;; (setq name string realdir dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4797 ;; (setq string (substitute-in-file-name string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4798 ;; name (file-name-nondirectory string)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4799 ;; realdir (file-name-directory string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4800 ;; (setq realdir (if realdir (expand-file-name realdir dir) dir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4801 ;; (if action
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4802 ;; (file-name-all-completions name realdir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4803 ;; (let ((specdir (file-name-directory string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4804 ;; (val (file-name-completion name realdir)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4805 ;; (if (and specdir (stringp val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4806 ;; (ange-ftp-quote-filename (concat specdir val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4807 ;; val))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4808
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4809 ;; Put these lines uncommmented in your .emacs if you want C-r to refresh
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4810 ;; ange-ftp's cache whilst doing filename completion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4811 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4812 ;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4813 ;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4814
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4815 (defun ange-ftp-re-read-dir (&optional dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4816 "Forces a re-read of the directory DIR. If DIR is omitted then it defaults
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4817 to the directory part of the contents of the current buffer."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4818 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4819 (if dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4820 (setq dir (expand-file-name dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4821 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4822 (if (ange-ftp-ftp-path dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4823 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4824 (setq ange-ftp-ls-cache-file nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4825 (ange-ftp-del-hash-entry dir ange-ftp-files-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4826 (ange-ftp-get-files dir t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4827
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4828 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4829 ;;;; Bits and bobs to bolt ange-ftp into GNU Emacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4830 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4831
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4832 (defvar ange-ftp-overwrite-msg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4833 "Note: This function has been modified to work with ange-ftp.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4834
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4835 (defun ange-ftp-safe-documentation (fun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4836 "A documentation function that isn't quite as fragile."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4837 (condition-case ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4838 (documentation fun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4839 (error nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4840
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4841 (defun ange-ftp-overwrite-fn (fun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4842 "Replace FUN's function definition with ange-ftp-FUN's, saving the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4843 original definition as ange-ftp-real-FUN. The original documentation is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4844 placed on the new definition suitably augmented."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4845 (let* ((name (symbol-name fun))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4846 (saved (intern (concat "ange-ftp-real-" name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4847 (new (intern (concat "ange-ftp-" name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4848 (nfun (symbol-function new))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4849 (exec-directory (if (or (equal (nth 3 command-line-args) "dump")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4850 (equal (nth 4 command-line-args) "dump"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4851 "../etc/"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4852 exec-directory)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4853
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4854 ;; *** This is unnecessary for any ange-ftp function (I think):
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4855 (while (symbolp nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4856 (setq nfun (symbol-function nfun)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4857
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4858 ;; Interpose the ange-ftp function between the function symbol and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4859 ;; original definition of the function symbol AT TIME OF FIRST LOAD.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4860 ;; We must only redefine the symbol-function of FUN the very first
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4861 ;; time, to avoid blowing away stuff that overloads FUN after this.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4862
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4863 ;; We direct the function symbol to the ange-ftp's function symbol
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4864 ;; rather than function definition to allow reloading of this file or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4865 ;; redefining of the individual function (e.g., during debugging)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4866 ;; later after some other code has been loaded on top of our stuff.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4867
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4868 (or (fboundp saved)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4869 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4870 (fset saved (symbol-function fun))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4871 (fset fun new)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4872
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4873 ;; Rewrite the doc string on the new ange-ftp function. This should
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4874 ;; be done every time the file is loaded (or a function is redefined),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4875 ;; because the underlying overloaded function may have changed its doc
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4876 ;; string.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4877
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4878 (let* ((doc-str (ange-ftp-safe-documentation saved))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4879 (ndoc-str (concat doc-str (and doc-str "\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4880 ange-ftp-overwrite-msg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4881
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4882 (cond ((listp nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4883 ;; Probe to test whether function is in preloaded read-only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4884 ;; memory, and if so make writable copy:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4885 (condition-case nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4886 (setcar nfun (car nfun))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4887 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4888 (setq nfun (copy-sequence nfun)) ; shallow copy only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4889 (fset new nfun)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4890 (let ((ndoc-cdr (nthcdr 2 nfun)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4891 (if (stringp (car ndoc-cdr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4892 ;; Replace the existing docstring.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4893 (setcar ndoc-cdr ndoc-str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4894 ;; There is no docstring. Insert the overwrite msg.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4895 (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4896 (setcar ndoc-cdr ange-ftp-overwrite-msg))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4897 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4898 ;; it's an emacs19 compiled-code object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4899 (if (not (fboundp 'compiled-function-arglist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4900 ;; the old way (typical emacs lack of abstraction)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4901 (let ((new-code (append nfun nil))) ; turn it into a list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4902 (if (nthcdr 4 new-code)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4903 (setcar (nthcdr 4 new-code) ndoc-str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4904 (setcdr (nthcdr 3 new-code) (cons ndoc-str nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4905 (fset new (apply 'make-byte-code new-code)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4906 ;; the new way (marginally less random) for XEmacs 19.8+
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4907 (fset new
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4908 (apply 'make-byte-code
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4909 (compiled-function-arglist nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4910 (compiled-function-instructions nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4911 (compiled-function-constants nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4912 (compiled-function-stack-depth nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4913 ndoc-str
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4914 (if (commandp nfun)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4915 (list (nth 1 (compiled-function-interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4916 nfun)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4917 nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4918 ))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4919
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4920 (defun ange-ftp-overwrite-dired ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4921 (if (not (fboundp 'dired-ls)) ;dired should have been loaded by now
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4922 (ange-ftp-overwrite-fn 'dired-readin) ; classic dired
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4923 (ange-ftp-overwrite-fn 'make-directory) ; tree dired and v19 stuff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4924 (ange-ftp-overwrite-fn 'remove-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4925 ;; XEmacs - not anymore because ange-ftp-diff is hosed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4926 ;; (ange-ftp-overwrite-fn 'diff)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4927 (ange-ftp-overwrite-fn 'dired-run-shell-command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4928 (ange-ftp-overwrite-fn 'dired-ls)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4929 (ange-ftp-overwrite-fn 'dired-call-process)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4930 ;; Can't use (fset 'ange-ftp-dired-readin 'ange-ftp-tree-dired-readin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4931 ;; here because it confuses ange-ftp-overwrite-fn.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4932 (fset 'ange-ftp-dired-readin (symbol-function 'ange-ftp-tree-dired-readin))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4933 (ange-ftp-overwrite-fn 'dired-readin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4934 (ange-ftp-overwrite-fn 'dired-insert-headerline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4935 (ange-ftp-overwrite-fn 'dired-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4936 (ange-ftp-overwrite-fn 'dired-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4937 (ange-ftp-overwrite-fn 'dired-get-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4938 (ange-ftp-overwrite-fn 'dired-between-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4939 (ange-ftp-overwrite-fn 'dired-clean-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4940 (ange-ftp-overwrite-fn 'dired-flag-backup-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4941 (ange-ftp-overwrite-fn 'dired-backup-diff)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4942 (if (fboundp 'dired-do-create-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4943 ;; dired 6.0 or later.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4944 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4945 (ange-ftp-overwrite-fn 'dired-copy-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4946 (ange-ftp-overwrite-fn 'dired-create-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4947 (ange-ftp-overwrite-fn 'dired-do-create-files)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4948 (if (fboundp 'dired-compress-make-compressed-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4949 ;; it's V5.255 or later
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4950 (ange-ftp-overwrite-fn 'dired-compress-make-compressed-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4951 ;; ange-ftp-overwrite-fn confuses dired-mark-map here.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4952 (fset 'ange-ftp-real-dired-compress (symbol-function 'dired-compress))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4953 (fset 'dired-compress 'ange-ftp-dired-compress)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4954 (fset 'ange-ftp-real-dired-uncompress (symbol-function 'dired-uncompress))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4955 (fset 'dired-uncompress 'ange-ftp-dired-uncompress)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4956
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4957 (ange-ftp-overwrite-fn 'dired-find-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4958 (ange-ftp-overwrite-fn 'dired-revert))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4959
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4960 ;; Attention!
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4961 ;; It would be nice if ange-ftp-add-hook was generalized to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4962 ;; (defun ange-ftp-add-hook (hook-var hook-function &optional postpend),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4963 ;; where the optional postpend variable stipulates that hook-function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4964 ;; should be post-pended to the hook-var, rather than prepended.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4965 ;; Then, maybe we should overwrite dired with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4966 ;; (ange-ftp-add-hook 'dired-load-hook 'ange-ftp-overwrite-dired t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4967 ;; This is because dired-load-hook is commonly used to add the dired extras
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4968 ;; features (dired-x.el, dired-trns.el, dired-nstd.el, ...). Some of these
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4969 ;; extras features overwrite functions in dired.el with fancier versions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4970 ;; The "extras" overwrites would then clobber the ange-ftp overwrites.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4971 ;; As long as the ange-ftp overwrites are carefully written to use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4972 ;; ange-ftp-real-... when the directory is local, then doing the ange-ftp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4973 ;; overwrites after the extras overwites should be OK.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4974 ;; At the moment, I think that there aren't any conflicts between the extras
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4975 ;; overwrites, and the ange-ftp overwrites. This may not last though.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4976
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4977 (defun ange-ftp-add-hook (hook-var hook-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4978 "Prepend hook-function to hook-var's value, if it is not already an element.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4979 hook-var's value may be a single function or a list of functions."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4980 (if (boundp hook-var)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4981 (let ((value (symbol-value hook-var)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4982 (if (and (listp value) (not (eq (car value) 'lambda)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4983 (and (not (memq hook-function value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4984 (set hook-var
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4985 (if value (cons hook-function value) hook-function)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4986 (and (not (eq hook-function value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4987 (set hook-var
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4988 (list hook-function value)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4989 (set hook-var hook-function)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4990
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4991 ;; To load ange-ftp and not dired (leaving it to autoload), define
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4992 ;; dired-load-hook and make sure dired.el ends with:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4993 ;; (run-hooks 'dired-load-hook)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4994 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4995 (if (and (boundp 'dired-load-hook)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4996 (not (featurep 'dired)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4997 (ange-ftp-add-hook 'dired-load-hook 'ange-ftp-overwrite-dired)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4998 (require 'dired)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4999 (ange-ftp-overwrite-dired))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5000
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5001 ;; In case v19 or emacs-19.el already loaded:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5002 ;; (Can't use fboundp to check if emacs-19.el is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5003 ;; loaded, because these functions are probably
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5004 ;; bound to autoloads.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5005
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5006 (if (and (fboundp 'make-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5007 (not (and (listp (symbol-function 'make-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5008 (eq (car (symbol-function 'make-directory)) 'autoload))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5009 (ange-ftp-overwrite-fn 'make-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5010 (if (and (fboundp 'remove-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5011 (not (and (listp (symbol-function 'remove-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5012 (eq (car (symbol-function 'remove-directory)) 'autoload))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5013 (ange-ftp-overwrite-fn 'remove-directory))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5014 ;; XEmacs change -- ange-ftp-diff is hosed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5015 ;;(if (and (fboundp 'diff)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5016 ;; (not (and (listp (symbol-function 'diff))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5017 ;; (eq (car (symbol-function 'diff)) 'autoload))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5018 ;; (ange-ftp-overwrite-fn 'diff))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5019
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5020 (ange-ftp-overwrite-fn 'insert-file-contents)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5021 (ange-ftp-overwrite-fn 'directory-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5022 (ange-ftp-overwrite-fn 'file-directory-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5023 (ange-ftp-overwrite-fn 'file-writable-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5024 (ange-ftp-overwrite-fn 'file-readable-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5025 (ange-ftp-overwrite-fn 'file-symlink-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5026 (ange-ftp-overwrite-fn 'delete-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5027 ;; (ange-ftp-overwrite-fn 'read-file-name-internal)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5028 (ange-ftp-overwrite-fn 'verify-visited-file-modtime)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5029 (ange-ftp-overwrite-fn 'file-exists-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5030 (ange-ftp-overwrite-fn 'write-region)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5031 (ange-ftp-overwrite-fn 'backup-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5032 (ange-ftp-overwrite-fn 'copy-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5033 (ange-ftp-overwrite-fn 'rename-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5034 (ange-ftp-overwrite-fn 'file-attributes)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5035 (ange-ftp-overwrite-fn 'file-name-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5036 (ange-ftp-overwrite-fn 'file-name-nondirectory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5037 (ange-ftp-overwrite-fn 'file-name-as-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5038 (ange-ftp-overwrite-fn 'directory-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5039 (ange-ftp-overwrite-fn 'expand-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5040 (ange-ftp-overwrite-fn 'file-name-all-completions)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5041 (ange-ftp-overwrite-fn 'file-name-completion)
4
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents: 2
diff changeset
5042 (ange-ftp-overwrite-fn 'load)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5043
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5044 (or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5045 (setq find-file-hooks
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5046 (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5047
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5048
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5049 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5050 ;;;; VOS support (VOS support is probably broken,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5051 ;;;; but I don't know anything about VOS.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5052 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5053 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5054 ;(defun ange-ftp-fix-path-for-vos (path &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5055 ; (setq path (copy-sequence path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5056 ; (let ((from (if reverse ?\> ?\/))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5057 ; (to (if reverse ?\/ ?\>))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5058 ; (i (1- (length path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5059 ; (while (>= i 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5060 ; (if (= (aref path i) from)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5061 ; (aset path i to))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5062 ; (setq i (1- i)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5063 ; path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5064 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5065 ;(or (assq 'vos ange-ftp-fix-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5066 ; (setq ange-ftp-fix-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5067 ; (cons '(vos . ange-ftp-fix-path-for-vos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5068 ; ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5069 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5070 ;(or (memq 'vos ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5071 ; (setq ange-ftp-dumb-host-types
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5072 ; (cons 'vos ange-ftp-dumb-host-types)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5073 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5074 ;(defun ange-ftp-fix-dir-path-for-vos (dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5075 ; (ange-ftp-fix-path-for-vos
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5076 ; (concat dir-path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5077 ; (if (eq ?/ (aref dir-path (1- (length dir-path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5078 ; "" "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5079 ; "*")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5080 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5081 ;(or (assq 'vos ange-ftp-fix-dir-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5082 ; (setq ange-ftp-fix-dir-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5083 ; (cons '(vos . ange-ftp-fix-dir-path-for-vos)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5084 ; ange-ftp-fix-dir-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5085 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5086 ;(defvar ange-ftp-vos-host-regexp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5087 ; "If a host matches this regexp then it is assumed to be running VOS.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5088 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5089 ;(defun ange-ftp-vos-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5090 ; (and ange-ftp-vos-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5091 ; (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5092 ; (string-match ange-ftp-vos-host-regexp host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5093 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5094 ;(defun ange-ftp-parse-vos-listing ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5095 ; "Parse the current buffer which is assumed to be in VOS list -all
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5096 ;format, and return a hashtable as the result."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5097 ; (let ((tbl (ange-ftp-make-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5098 ; (type-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5099 ; '(("^Files: [0-9]+ +Blocks: [0-9]+\n+" nil 40)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5100 ; ("^Dirs: [0-9]+\n+" t 30)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5101 ; type-regexp type-is-dir type-col file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5102 ; (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5103 ; (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5104 ; (while type-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5105 ; (setq type-regexp (car (car type-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5106 ; type-is-dir (nth 1 (car type-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5107 ; type-col (nth 2 (car type-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5108 ; type-list (cdr type-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5109 ; (if (re-search-forward type-regexp nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5110 ; (while (eq (char-after (point)) ? )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5111 ; (move-to-column type-col)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5112 ; (setq file (buffer-substring (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5113 ; (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5114 ; (end-of-line 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5115 ; (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5116 ; (ange-ftp-put-hash-entry file type-is-dir tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5117 ; (forward-line 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5118 ; (ange-ftp-put-hash-entry "." 'vosdir tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5119 ; (ange-ftp-put-hash-entry ".." 'vosdir tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5120 ; tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5121 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5122 ;(or (assq 'vos ange-ftp-parse-list-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5123 ; (setq ange-ftp-parse-list-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5124 ; (cons '(vos . ange-ftp-parse-vos-listing)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5125 ; ange-ftp-parse-list-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5126
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5127 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5128 ;;;; VMS support.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5129 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5130
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5131 (defun ange-ftp-fix-path-for-vms (path &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5132 "Convert PATH from UNIX-ish to VMS. If REVERSE given then convert from VMS
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5133 to UNIX-ish."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5134 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5135 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5136 (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5137 (let (drive dir file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5138 (if (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5139 (setq drive (substring path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5140 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5141 (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5142 (if (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5143 (setq dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5144 (substring path (match-beginning 2) (match-end 2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5145 (if (match-beginning 3)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5146 (setq file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5147 (substring path (match-beginning 3) (match-end 3))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5148 (and dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5149 (setq dir (apply (function concat)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5150 (mapcar (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5151 (lambda (char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5152 (if (= char ?.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5153 (vector ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5154 (vector char))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5155 (substring dir 1 -1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5156 (concat (and drive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5157 (concat "/" drive "/"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5158 dir (and dir "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5159 file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5160 (error "path %s didn't match" path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5161 (let (drive dir file tmp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5162 (if (string-match "^/[^:]+:/" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5163 (setq drive (substring path 1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5164 (1- (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5165 path (substring path (match-end 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5166 (setq tmp (file-name-directory path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5167 (if tmp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5168 (setq dir (apply (function concat)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5169 (mapcar (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5170 (lambda (char)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5171 (if (= char ?/)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5172 (vector ?.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5173 (vector char))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5174 (substring tmp 0 -1)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5175 (setq file (file-name-nondirectory path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5176 (concat drive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5177 (and dir (concat "[" (if drive nil ".") dir "]"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5178 file)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5179
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5180 ;; (ange-ftp-fix-path-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5181 ;; (ange-ftp-fix-path-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5182
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5183 (or (assq 'vms ange-ftp-fix-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5184 (setq ange-ftp-fix-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5185 (cons '(vms . ange-ftp-fix-path-for-vms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5186 ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5187
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5188 (or (memq 'vms ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5189 (setq ange-ftp-dumb-host-types
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5190 (cons 'vms ange-ftp-dumb-host-types)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5191
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5192 ;; It is important that this function barf for directories for which we know
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5193 ;; that we cannot possibly get a directory listing, such as "/" and "/DEV:/".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5194 ;; This is because it saves an unnecessary FTP error, or possibly the listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5195 ;; might succeed, but give erroneous info. This last case is particularly
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5196 ;; likely for OS's (like MTS) for which we need to use a wildcard in order
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5197 ;; to list a directory.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5198
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5199 (defun ange-ftp-fix-dir-path-for-vms (dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5200 "Convert path from UNIX-ish to VMS ready for a DIRectory listing."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5201 ;; Should there be entries for .. -> [-] and . -> [] below. Don't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5202 ;; think so, because expand-filename should have already short-circuited
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5203 ;; them.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5204 (cond ((string-equal dir-path "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5205 (error "Cannot get listing for fictitious \"/\" directory."))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5206 ((string-match "^/[-A-Z0-9_$]+:/$" dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5207 (error "Cannot get listing for device."))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5208 ((ange-ftp-fix-path-for-vms dir-path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5209
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5210 (or (assq 'vms ange-ftp-fix-dir-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5211 (setq ange-ftp-fix-dir-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5212 (cons '(vms . ange-ftp-fix-dir-path-for-vms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5213 ange-ftp-fix-dir-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5214
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5215 (defvar ange-ftp-vms-host-regexp nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5216
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5217 (defun ange-ftp-vms-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5218 "Return whether HOST is running VMS."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5219 (and ange-ftp-vms-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5220 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5221 (string-match ange-ftp-vms-host-regexp host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5222
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5223 ;; Because some VMS ftp servers convert filenames to lower case
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5224 ;; we allow a-z in the filename regexp. I'm not too happy about this.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5225
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5226 (defconst ange-ftp-vms-filename-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5227 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5228 "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][_A-Za-z0-9$---]*\\)\\."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5229 "[_A-Za-z0-9$---]*;+[0-9]*\\)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5230 "Regular expression to match for a valid VMS file name in Dired buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5231 Stupid freaking bug! Position of _ and $ shouldn't matter but they do.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5232 Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5233 Other orders of $ and _ seem to all work just fine.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5234
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5235 ;; These parsing functions are as general as possible because the syntax
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5236 ;; of ftp listings from VMS hosts is a bit erratic. What saves us is that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5237 ;; the VMS filename syntax is so rigid. If they bomb on a listing in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5238 ;; standard VMS Multinet format, then this is a bug. If they bomb on a listing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5239 ;; from vms.weird.net, then too bad.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5240
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5241 (defun ange-ftp-parse-vms-filename ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5242 "Extract the next filename from a VMS dired-like listing."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5243 (if (re-search-forward
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5244 ange-ftp-vms-filename-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5245 nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5246 (buffer-substring (match-beginning 0) (match-end 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5247
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5248 (defun ange-ftp-parse-vms-listing ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5249 "Parse the current buffer which is assumed to be in MultiNet FTP dir
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5250 format, and return a hashtable as the result."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5251 (let ((tbl (ange-ftp-make-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5252 file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5253 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5254 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5255 (while (setq file (ange-ftp-parse-vms-filename))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5256 (if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5257 ;; deal with directories
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5258 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5259 (substring file 0 (match-beginning 0)) t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5260 (ange-ftp-put-hash-entry file nil tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5261 (if (string-match ";[0-9]+$" file) ; deal with extension
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5262 ;; sans extension
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5263 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5264 (substring file 0 (match-beginning 0)) nil tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5265 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5266 ;; Would like to look for a "Total" line, or a "Directory" line to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5267 ;; make sure that the listing isn't complete garbage before putting
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5268 ;; in "." and "..", but we can't even count on all VAX's giving us
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5269 ;; either of these.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5270 (ange-ftp-put-hash-entry "." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5271 (ange-ftp-put-hash-entry ".." t tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5272 tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5273
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5274 (or (assq 'vms ange-ftp-parse-list-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5275 (setq ange-ftp-parse-list-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5276 (cons '(vms . ange-ftp-parse-vms-listing)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5277 ange-ftp-parse-list-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5278
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5279 ;; This version only deletes file entries which have
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5280 ;; explicit version numbers, because that is all VMS allows.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5281
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5282 ;; Can the following two functions be speeded up using file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5283 ;; completion functions?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5284
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5285 (defun ange-ftp-vms-delete-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5286 (if dir-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5287 (ange-ftp-internal-delete-file-entry path t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5288 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5289 (let ((file (ange-ftp-get-file-part path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5290 (if (string-match ";[0-9]+$" file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5291 ;; In VMS you can't delete a file without an explicit
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5292 ;; version number, or wild-card (e.g. FOO;*)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5293 ;; For now, we give up on wildcards.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5294 (let ((files (ange-ftp-get-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5295 (file-name-directory path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5296 ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5297 (if files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5298 (let* ((root (substring file 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5299 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5300 (regexp (concat "^"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5301 (regexp-quote root)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5302 ";[0-9]+$"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5303 versions)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5304 (ange-ftp-del-hash-entry file files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5305 ;; Now we need to check if there are any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5306 ;; versions left. If not, then delete the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5307 ;; root entry.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5308 (mapatoms
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5309 '(lambda (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5310 (and (string-match regexp (get sym 'key))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5311 (setq versions t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5312 files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5313 (or versions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5314 (ange-ftp-del-hash-entry root files))))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5315
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5316 (or (assq 'vms ange-ftp-delete-file-entry-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5317 (setq ange-ftp-delete-file-entry-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5318 (cons '(vms . ange-ftp-vms-delete-file-entry)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5319 ange-ftp-delete-file-entry-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5320
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5321 (defun ange-ftp-vms-add-file-entry (path &optional dir-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5322 (if dir-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5323 (ange-ftp-internal-add-file-entry path t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5324 (let ((files (ange-ftp-get-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5325 (file-name-directory path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5326 ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5327 (if files
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5328 (let ((file (ange-ftp-get-file-part path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5329 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5330 (if (string-match ";[0-9]+$" file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5331 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5332 (substring file 0 (match-beginning 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5333 nil files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5334 ;; Need to figure out what version of the file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5335 ;; is being added.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5336 (let ((regexp (concat "^"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5337 (regexp-quote file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5338 ";\\([0-9]+\\)$"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5339 (version 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5340 (mapatoms
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5341 '(lambda (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5342 (let ((name (get sym 'key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5343 (and (string-match regexp name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5344 (setq version
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5345 (max version
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5346 (string-to-int
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5347 (substring name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5348 (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5349 (match-end 1))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5350 files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5351 (setq version (1+ version))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5352 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5353 (concat file ";" (int-to-string version))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5354 nil files))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5355 (ange-ftp-put-hash-entry file nil files))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5356
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5357 (or (assq 'vms ange-ftp-add-file-entry-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5358 (setq ange-ftp-add-file-entry-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5359 (cons '(vms . ange-ftp-vms-add-file-entry)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5360 ange-ftp-add-file-entry-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5361
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5362
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5363 (defun ange-ftp-add-vms-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5364 "Interactively adds a given HOST to ange-ftp-vms-host-regexp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5365 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5366 (list (read-string "Host: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5367 (let ((name (or (buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5368 (and (eq major-mode 'dired-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5369 dired-directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5370 (and name (car (ange-ftp-ftp-path name)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5371 (if (not (ange-ftp-vms-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5372 (setq ange-ftp-vms-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5373 (concat "^" (regexp-quote host) "$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5374 (and ange-ftp-vms-host-regexp "\\|")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5375 ange-ftp-vms-host-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5376 ange-ftp-host-cache nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5377
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5378
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5379 (defun ange-ftp-vms-file-name-as-directory (name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5380 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5381 (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5382 (setq name (substring name 0 (match-beginning 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5383 (ange-ftp-real-file-name-as-directory name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5384
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5385 (or (assq 'vms ange-ftp-file-name-as-directory-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5386 (setq ange-ftp-file-name-as-directory-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5387 (cons '(vms . ange-ftp-vms-file-name-as-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5388 ange-ftp-file-name-as-directory-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5389
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5390 ;;; Tree dired support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5391
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5392 ;; For this code I have borrowed liberally from Sebastian Kremer's
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5393 ;; dired-vms.el
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5394
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5395
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5396 ;; These regexps must be anchored to beginning of line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5397 ;; Beware that the ftpd may put the device in front of the filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5398
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5399 (defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5400 "Regular expression to use to search for VMS executable files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5401
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5402 (defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5403 "Regular expression to use to search for VMS directories.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5404
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5405 (or (assq 'vms ange-ftp-dired-re-exe-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5406 (setq ange-ftp-dired-re-exe-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5407 (cons (cons 'vms ange-ftp-dired-vms-re-exe)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5408 ange-ftp-dired-re-exe-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5409
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5410 (or (assq 'vms ange-ftp-dired-re-dir-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5411 (setq ange-ftp-dired-re-dir-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5412 (cons (cons 'vms ange-ftp-dired-vms-re-dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5413 ange-ftp-dired-re-dir-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5414
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5415 (defun ange-ftp-dired-vms-insert-headerline (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5416 ;; VMS inserts a headerline. I would prefer the headerline
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5417 ;; to be in ange-ftp format. This version tries to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5418 ;; be careful, because we can't count on a headerline
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5419 ;; over ftp, and we wouldn't want to delete anything
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5420 ;; important.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5421 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5422 (if (looking-at "^ wildcard ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5423 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5424 (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5425 (delete-region (point) (match-end 0))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5426 (ange-ftp-real-dired-insert-headerline dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5427
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5428 (or (assq 'vms ange-ftp-dired-insert-headerline-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5429 (setq ange-ftp-dired-insert-headerline-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5430 (cons '(vms . ange-ftp-dired-vms-insert-headerline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5431 ange-ftp-dired-insert-headerline-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5432
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5433 (defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5434 "In dired, move to first char of filename on this line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5435 Returns position (point) or nil if no filename on this line."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5436 ;; This is the VMS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5437 (let (case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5438 (or eol (setq eol (progn (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5439 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5440 (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5441 (goto-char (match-beginning 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5442 (if raise-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5443 (error "No file on this line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5444 nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5445
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5446 (or (assq 'vms ange-ftp-dired-move-to-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5447 (setq ange-ftp-dired-move-to-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5448 (cons '(vms . ange-ftp-dired-vms-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5449 ange-ftp-dired-move-to-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5450
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5451 (defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5452 ;; Assumes point is at beginning of filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5453 ;; So, it should be called only after (dired-move-to-filename t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5454 ;; case-fold-search must be nil, at least for VMS.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5455 ;; On failure, signals an error or returns nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5456 ;; This is the VMS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5457 (let (opoint hidden case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5458 (setq opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5459 (or eol (setq eol (save-excursion (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5460 (setq hidden (and selective-display
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5461 (save-excursion (search-forward "\r" eol t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5462 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5463 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5464 (re-search-forward ange-ftp-vms-filename-regexp eol t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5465 (or no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5466 (not (eq opoint (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5467 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5468 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5469 (substitute-command-keys
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5470 "File line is hidden, type \\[dired-hide-subdir] to unhide")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5471 "No file on this line")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5472 (if (eq opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5473 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5474 (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5475
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5476 (or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5477 (setq ange-ftp-dired-move-to-end-of-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5478 (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5479 ange-ftp-dired-move-to-end-of-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5480
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5481 (defun ange-ftp-dired-vms-between-files ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5482 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5483 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5484 (or (equal (following-char) 10) ; newline
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5485 (equal (following-char) 9) ; tab
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5486 (progn (forward-char 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5487 (or (looking-at "Total of")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5488 (equal (following-char) 32))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5489
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5490 (or (assq 'vms ange-ftp-dired-between-files-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5491 (setq ange-ftp-dired-between-files-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5492 (cons '(vms . ange-ftp-dired-vms-between-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5493 ange-ftp-dired-between-files-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5494
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5495 ;; Beware! In VMS filenames must be of the form "FILE.TYPE".
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5496 ;; Therefore, we cannot just append a ".Z" to filenames for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5497 ;; compressed files. Instead, we turn "FILE.TYPE" into
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5498 ;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5499
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5500 (defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5501 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5502 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5503 ((string-match "-Z;[0-9]+$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5504 (substring name 0 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5505 ((string-match ";[0-9]+$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5506 (substring name 0 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5507 ((string-match "-Z$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5508 (substring name 0 -2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5509 (t name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5510 (if (string-match ";[0-9]+$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5511 (concat (substring name 0 (match-beginning 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5512 "-Z")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5513 (concat name "-Z"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5514
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5515 (or (assq 'vms ange-ftp-dired-compress-make-compressed-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5516 (setq ange-ftp-dired-compress-make-compressed-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5517 (cons '(vms . ange-ftp-vms-make-compressed-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5518 ange-ftp-dired-compress-make-compressed-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5519
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5520 ;; When the filename is too long, VMS will use two lines to list a file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5521 ;; (damn them!) This will confuse dired. To solve this, need to convince
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5522 ;; Sebastian to use a function dired-go-to-end-of-file-line, instead of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5523 ;; (forward-line 1). This would require a number of changes to dired.el.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5524 ;; If dired gets confused, revert-buffer will fix it.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5525
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5526 (defun ange-ftp-dired-vms-ls-trim ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5527 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5528 (let ((case-fold-search nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5529 (re-search-forward ange-ftp-vms-filename-regexp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5530 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5531 (delete-region (point-min) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5532 (forward-line 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5533 (delete-region (point) (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5534
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5535
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5536 (or (assq 'vms ange-ftp-dired-ls-trim-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5537 (setq ange-ftp-dired-ls-trim-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5538 (cons '(vms . ange-ftp-dired-vms-ls-trim)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5539 ange-ftp-dired-ls-trim-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5540
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5541 (defun ange-ftp-vms-bob-version (name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5542 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5543 (if (string-match ";[0-9]+$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5544 (substring name 0 (match-beginning 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5545 name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5546
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5547 (or (assq 'vms ange-ftp-bob-version-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5548 (setq ange-ftp-bob-version-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5549 (cons '(vms . ange-ftp-vms-bob-version)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5550 ange-ftp-bob-version-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5551
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5552 ;;; The vms version of clean-directory has 2 more optional args
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5553 ;;; than the usual dired version. This is so that it can be used by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5554 ;;; ange-ftp-dired-vms-flag-backup-files.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5555
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5556 (defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5557 "Flag numerical backups for deletion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5558 Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5559 Positive prefix arg KEEP overrides `dired-kept-versions';
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5560 Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5561
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5562 To clear the flags on these files, you can use \\[dired-flag-backup-files]
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5563 with a prefix argument."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5564 ; (interactive "P") ; Never actually called interactively.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5565 (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5566 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5567 ;; late-retention must NEVER be allowed to be less than 1 in VMS!
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5568 ;; This could wipe ALL copies of the file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5569 (late-retention (max 1 (if (<= keep 0) dired-kept-versions keep)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5570 (action (or msg "Cleaning"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5571 (trample-marker (or marker dired-del-marker))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5572 (file-version-assoc-list ()))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5573 (message (concat action
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5574 " numerical backups (keeping %d late, %d old)...")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5575 late-retention early-retention)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5576 ;; Look at each file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5577 ;; If the file has numeric backup versions,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5578 ;; put on file-version-assoc-list an element of the form
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5579 ;; (FILENAME . VERSION-NUMBER-LIST)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5580 (dired-map-dired-file-lines (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5581 ange-ftp-dired-vms-collect-file-versions))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5582 ;; Sort each VERSION-NUMBER-LIST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5583 ;; and remove the versions not to be deleted.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5584 (let ((fval file-version-assoc-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5585 (while fval
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5586 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5587 (v-count (length sorted-v-list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5588 (if (> v-count (+ early-retention late-retention))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5589 (rplacd (nthcdr early-retention sorted-v-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5590 (nthcdr (- v-count late-retention)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5591 sorted-v-list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5592 (rplacd (car fval)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5593 (cdr sorted-v-list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5594 (setq fval (cdr fval))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5595 ;; Look at each file. If it is a numeric backup file,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5596 ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5597 (dired-map-dired-file-lines
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5598 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5599 ange-ftp-dired-vms-trample-file-versions mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5600 (message (concat action " numerical backups...done"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5601
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5602 (or (assq 'vms ange-ftp-dired-clean-directory-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5603 (setq ange-ftp-dired-clean-directory-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5604 (cons '(vms . ange-ftp-dired-vms-clean-directory)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5605 ange-ftp-dired-clean-directory-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5606
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5607 (defun ange-ftp-dired-vms-collect-file-versions (fn)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5608 ;; "If it looks like file FN has versions, return a list of the versions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5609 ;;That is a list of strings which are file names.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5610 ;;The caller may want to flag some of these files for deletion."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5611 (let ((path (nth 2 (ange-ftp-ftp-path fn))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5612 (if (string-match ";[0-9]+$" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5613 (let* ((path (substring path 0 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5614 (fn (ange-ftp-replace-path-component fn path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5615 (if (not (assq fn file-version-assoc-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5616 (let* ((base-versions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5617 (concat (file-name-nondirectory path) ";"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5618 (bv-length (length base-versions))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5619 (possibilities (file-name-all-completions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5620 base-versions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5621 (file-name-directory fn)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5622 (versions (mapcar
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5623 '(lambda (arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5624 (if (and (string-match
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5625 "[0-9]+$" arg bv-length)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5626 (= (match-beginning 0) bv-length))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5627 (string-to-int (substring arg bv-length))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5628 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5629 possibilities)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5630 (if versions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5631 (setq
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5632 file-version-assoc-list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5633 (cons (cons fn versions)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5634 file-version-assoc-list)))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5635
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5636 (defun ange-ftp-dired-vms-trample-file-versions (fn)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5637 (let* ((start-vn (string-match ";[0-9]+$" fn))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5638 base-version-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5639 (and start-vn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5640 (setq base-version-list ; there was a base version to which
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5641 (assoc (substring fn 0 start-vn) ; this looks like a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5642 file-version-assoc-list)) ; subversion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5643 (not (memq (string-to-int (substring fn (1+ start-vn)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5644 base-version-list)) ; this one doesn't make the cut
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5645 (progn (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5646 (delete-char 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5647 (insert trample-marker)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5648
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5649 (defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5650 (let ((dired-kept-versions 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5651 (kept-old-versions 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5652 marker msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5653 (if unflag-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5654 (setq marker ?\040 msg "Unflagging")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5655 (setq marker dired-del-marker msg "Cleaning"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5656 (ange-ftp-dired-vms-clean-directory nil marker msg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5657
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5658 (or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5659 (setq ange-ftp-dired-flag-backup-files-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5660 (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5661 ange-ftp-dired-flag-backup-files-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5662
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5663 (defun ange-ftp-dired-vms-backup-diff (&optional switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5664 (let ((file (dired-get-filename 'no-dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5665 bak)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5666 (if (and (string-match ";[0-9]+$" file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5667 ;; Find most recent previous version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5668 (let ((root (substring file 0 (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5669 (ver
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5670 (string-to-int (substring file (1+ (match-beginning 0)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5671 found)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5672 (setq ver (1- ver))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5673 (while (and (> ver 0) (not found))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5674 (setq bak (concat root ";" (int-to-string ver)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5675 (and (file-exists-p bak) (setq found t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5676 (setq ver (1- ver)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5677 found))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5678 (if switches
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5679 (diff (expand-file-name bak) (expand-file-name file) switches)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5680 (diff (expand-file-name bak) (expand-file-name file)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5681 (error "No previous version found for %s" file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5682
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5683 (or (assq 'vms ange-ftp-dired-backup-diff-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5684 (setq ange-ftp-dired-backup-diff-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5685 (cons '(vms . ange-ftp-dired-vms-backup-diff)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5686 ange-ftp-dired-backup-diff-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5687
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5688
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5689 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5690 ;;;; MTS support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5691 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5692
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5693
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5694 (defun ange-ftp-fix-path-for-mts (path &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5695 "Convert PATH from UNIX-ish to MTS. If REVERSE given then convert from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5696 MTS to UNIX-ish."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5697 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5698 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5699 (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5700 (let (acct file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5701 (if (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5702 (setq acct (substring path 0 (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5703 (if (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5704 (setq file (substring path
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5705 (match-beginning 2) (match-end 2))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5706 (concat (and acct (concat "/" acct "/"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5707 file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5708 (error "path %s didn't match" path))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5709 (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5710 (concat (substring path 1 (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5711 (substring path (match-beginning 2) (match-end 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5712 ;; Let's hope that mts will recognize it anyway.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5713 path))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5714
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5715 (or (assq 'mts ange-ftp-fix-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5716 (setq ange-ftp-fix-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5717 (cons '(mts . ange-ftp-fix-path-for-mts)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5718 ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5719
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5720 (defun ange-ftp-fix-dir-path-for-mts (dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5721 "Convert path from UNIX-ish to MTS ready for a DIRectory listing.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5722 Remember that there are no directories in MTS."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5723 (if (string-equal dir-path "/")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5724 (error "Cannot get listing for fictitious \"/\" directory.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5725 (let ((dir-path (ange-ftp-fix-path-for-mts dir-path)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5726 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5727 ((string-equal dir-path "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5728 "?")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5729 ((string-match ":$" dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5730 (concat dir-path "?"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5731 (dir-path))))) ; It's just a single file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5732
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5733 (or (assq 'mts ange-ftp-fix-dir-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5734 (setq ange-ftp-fix-dir-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5735 (cons '(mts . ange-ftp-fix-dir-path-for-mts)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5736 ange-ftp-fix-dir-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5737
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5738 (or (memq 'mts ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5739 (setq ange-ftp-dumb-host-types
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5740 (cons 'mts ange-ftp-dumb-host-types)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5741
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5742 (defvar ange-ftp-mts-host-regexp nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5743
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5744 (defun ange-ftp-mts-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5745 "Return whether HOST is running MTS."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5746 (and ange-ftp-mts-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5747 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5748 (string-match ange-ftp-mts-host-regexp host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5749
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5750 (defun ange-ftp-parse-mts-listing ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5751 "Parse the current buffer which is assumed to be in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5752 mts ftp dir format."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5753 (let ((tbl (ange-ftp-make-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5754 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5755 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5756 (while (re-search-forward ange-ftp-date-regexp nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5757 (end-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5758 (skip-chars-backward " ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5759 (let ((end (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5760 (skip-chars-backward "-A-Z0-9_.!")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5761 (ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5762 (forward-line 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5763 ;; Don't need to bother with ..
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5764 (ange-ftp-put-hash-entry "." t tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5765 tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5766
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5767 (or (assq 'mts ange-ftp-parse-list-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5768 (setq ange-ftp-parse-list-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5769 (cons '(mts . ange-ftp-parse-mts-listing)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5770 ange-ftp-parse-list-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5771
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5772 (defun ange-ftp-add-mts-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5773 "Interactively adds a given HOST to ange-ftp-mts-host-regexp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5774 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5775 (list (read-string "Host: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5776 (let ((name (or (buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5777 (and (eq major-mode 'dired-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5778 dired-directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5779 (and name (car (ange-ftp-ftp-path name)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5780 (if (not (ange-ftp-mts-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5781 (setq ange-ftp-mts-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5782 (concat "^" (regexp-quote host) "$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5783 (and ange-ftp-mts-host-regexp "\\|")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5784 ange-ftp-mts-host-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5785 ange-ftp-host-cache nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5786
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5787 ;;; Tree dired support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5788
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5789 ;; There aren't too many systems left that use MTS. This dired support will
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5790 ;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5791 ;; implement ftp in the same way. If not, it might be necessary to make the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5792 ;; following more flexible.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5793
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5794 (defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5795 "In dired, move to first char of filename on this line.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5796 Returns position (point) or nil if no filename on this line."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5797 ;; This is the MTS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5798 (or eol (setq eol (progn (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5799 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5800 (if (re-search-forward
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5801 ange-ftp-date-regexp eol t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5802 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5803 (skip-chars-forward " ") ; Eat blanks after date
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5804 (skip-chars-forward "0-9:" eol) ; Eat time or year
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5805 (skip-chars-forward " " eol) ; one space before filename
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5806 ;; When listing an account other than the users own account it appends
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5807 ;; ACCT: to the beginning of the filename. Skip over this.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5808 (and (looking-at "[A-Z0-9_.]+:")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5809 (goto-char (match-end 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5810 (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5811 (if raise-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5812 (error "No file on this line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5813 nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5814
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5815 (or (assq 'mts ange-ftp-dired-move-to-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5816 (setq ange-ftp-dired-move-to-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5817 (cons '(mts . ange-ftp-dired-mts-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5818 ange-ftp-dired-move-to-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5819
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5820 (defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5821 ;; Assumes point is at beginning of filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5822 ;; So, it should be called only after (dired-move-to-filename t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5823 ;; On failure, signals an error or returns nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5824 ;; This is the MTS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5825 (let (opoint hidden case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5826 (setq opoint (point)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5827 eol (save-excursion (end-of-line) (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5828 hidden (and selective-display
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5829 (save-excursion (search-forward "\r" eol t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5830 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5831 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5832 (skip-chars-forward "-A-Z0-9._!" eol))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5833 (or no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5834 (not (eq opoint (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5835 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5836 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5837 (substitute-command-keys
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5838 "File line is hidden, type \\[dired-hide-subdir] to unhide")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5839 "No file on this line")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5840 (if (eq opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5841 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5842 (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5843
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5844 (or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5845 (setq ange-ftp-dired-move-to-end-of-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5846 (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5847 ange-ftp-dired-move-to-end-of-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5848
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5849 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5850 ;;;; CMS support
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5851 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5852
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5853 ;; Since CMS doesn't have any full pathname syntax, we have to fudge
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5854 ;; things with cd's. We actually send too many cd's, but is dangerous
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5855 ;; to try to remember the current minidisk, because if the connection
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5856 ;; is closed and needs to be reopened, we will find ourselves back in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5857 ;; the default minidisk. This is fairly likely since CMS ftp servers
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5858 ;; usually close the connection after 5 minutes of inactivity.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5859
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5860 ;; Have I got the filename character set right?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5861
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5862 (defun ange-ftp-fix-path-for-cms (path &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5863 "Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5864 from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5865 so we fudge things by sending cd's."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5866 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5867 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5868 ;; Since we only convert output from a pwd in this direction,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5869 ;; we'll assume that it's a minidisk, and make it into a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5870 ;; directory file name. Note that the expand-dir-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5871 ;; stores directories without the trailing /. Is this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5872 ;; consistent?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5873 (concat "/" path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5874 (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5875 path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5876 (let ((minidisk (substring path 1 (match-end 1))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5877 (if (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5878 (let ((file (substring path (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5879 (match-end 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5880 (cmd (concat "cd " minidisk))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5881
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5882 ;; Note that host and user are bound in the call
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5883 ;; to ange-ftp-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5884 (proc (ange-ftp-get-process host user)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5885
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5886 ;; Must use ange-ftp-raw-send-cmd here to avoid
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5887 ;; an infinite loop.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5888 (if (car (ange-ftp-raw-send-cmd proc cmd msg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5889 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5890 ;; failed... try ONCE more.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5891 (setq proc (ange-ftp-get-process host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5892 (let ((result (ange-ftp-raw-send-cmd proc cmd msg)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5893 (if (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5894 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5895 ;; failed. give up.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5896 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5897 (format "cd to minidisk %s failed: %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5898 minidisk (cdr result)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5899 ;; return the minidisk
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5900 minidisk))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5901 (error "Invalid CMS filename")))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5902
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5903 (or (assq 'cms ange-ftp-fix-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5904 (setq ange-ftp-fix-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5905 (cons '(cms . ange-ftp-fix-path-for-cms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5906 ange-ftp-fix-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5907
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5908 (or (memq 'cms ange-ftp-dumb-host-types)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5909 (setq ange-ftp-dumb-host-types
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5910 (cons 'cms ange-ftp-dumb-host-types)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5911
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5912 (defun ange-ftp-fix-dir-path-for-cms (dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5913 "Convert path from UNIX-ish to VMS ready for a DIRectory listing."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5914 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5915 ((string-equal "/" dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5916 (error "Cannot get listing for fictitious \"/\" directory."))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5917 ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-path)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5918 (let* ((minidisk (substring dir-path (match-beginning 1) (match-end 1)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5919 ;; host and user are bound in the call to ange-ftp-send-cmd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5920 (proc (ange-ftp-get-process host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5921 (cmd (concat "cd " minidisk))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5922 (file (if (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5923 ;; it's a single file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5924 (substring path (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5925 (match-end 2))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5926 ;; use the wild-card
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5927 "*")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5928 (if (car (ange-ftp-raw-send-cmd proc cmd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5929 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5930 ;; try again...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5931 (setq proc (ange-ftp-get-process host user))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5932 (let ((result (ange-ftp-raw-send-cmd proc cmd)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5933 (if (car result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5934 file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5935 ;; give up
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5936 (ange-ftp-error host user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5937 (format "cd to minidisk %s failed: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5938 minidisk (cdr result))))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5939 (t (error "Invalid CMS pathname"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5940
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5941 (or (assq 'cms ange-ftp-fix-dir-path-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5942 (setq ange-ftp-fix-dir-path-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5943 (cons '(cms . ange-ftp-fix-dir-path-for-cms)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5944 ange-ftp-fix-dir-path-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5945
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5946 (defvar ange-ftp-cms-host-regexp nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5947 "Regular expression to match hosts running the CMS operating system.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5948
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5949 (defun ange-ftp-cms-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5950 "Return whether the host is running CMS."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5951 (and ange-ftp-cms-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5952 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5953 (string-match ange-ftp-cms-host-regexp host))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5954
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5955 (defun ange-ftp-add-cms-host (host)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5956 "Interactively adds a given HOST to ange-ftp-cms-host-regexp."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5957 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5958 (list (read-string "Host: "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5959 (let ((name (or (buffer-file-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5960 (and (eq major-mode 'dired-mode)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5961 dired-directory))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5962 (and name (car (ange-ftp-ftp-path name)))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5963 (if (not (ange-ftp-cms-host host))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5964 (setq ange-ftp-cms-host-regexp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5965 (concat "^" (regexp-quote host) "$"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5966 (and ange-ftp-cms-host-regexp "\\|")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5967 ange-ftp-cms-host-regexp)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5968 ange-ftp-host-cache nil)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5969
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5970 (defun ange-ftp-parse-cms-listing ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5971 "Parse the current buffer which is assumed to be a CMS directory listing."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5972 ;; If we succeed in getting a listing, then we will assume that the minidisk
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5973 ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5974 ;; because ange-ftp doesn't know that the root hashtable has only part of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5975 ;; the info. It will assume that if a minidisk isn't in it, then it doesn't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5976 ;; exist. It would be nice if completion worked for minidisks, as we
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5977 ;; discover them.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5978 ; (let* ((dir-file (directory-file-name file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5979 ; (root (file-name-directory dir-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5980 ; (minidisk (ange-ftp-get-file-part dir-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5981 ; (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5982 ; (if root-tbl
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5983 ; (ange-ftp-put-hash-entry minidisk t root-tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5984 ; (setq root-tbl (ange-ftp-make-hashtable))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5985 ; (ange-ftp-put-hash-entry minidisk t root-tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5986 ; (ange-ftp-put-hash-entry "." t root-tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5987 ; (ange-ftp-set-files root root-tbl)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5988 ;; Now do the usual parsing
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5989 (let ((tbl (ange-ftp-make-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5990 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5991 (ange-ftp-save-match-data
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5992 (while
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5993 (re-search-forward
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5994 "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5995 (ange-ftp-put-hash-entry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5996 (concat (buffer-substring (match-beginning 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5997 (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5998 "."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5999 (buffer-substring (match-beginning 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6000 (match-end 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6001 nil tbl)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6002 (forward-line 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6003 (ange-ftp-put-hash-entry "." t tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6004 tbl))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6005
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6006 (or (assq 'cms ange-ftp-parse-list-func-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6007 (setq ange-ftp-parse-list-func-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6008 (cons '(cms . ange-ftp-parse-cms-listing)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6009 ange-ftp-parse-list-func-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6010
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6011 ;;; Tree dired support:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6012
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6013 (defconst ange-ftp-dired-cms-re-exe
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6014 "^. [-A-Z0-9$_]+ +EXEC "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6015 "Regular expression to use to search for CMS executables.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6016
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6017 (or (assq 'cms ange-ftp-dired-re-exe-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6018 (setq ange-ftp-dired-re-exe-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6019 (cons (cons 'cms ange-ftp-dired-cms-re-exe)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6020 ange-ftp-dired-re-exe-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6021
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6022
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6023 (defun ange-ftp-dired-cms-insert-headerline (dir)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6024 ;; CMS has no total line, so we insert a blank line for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6025 ;; aesthetics.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6026 (insert "\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6027 (forward-char -1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6028 (ange-ftp-real-dired-insert-headerline dir))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6029
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6030 (or (assq 'cms ange-ftp-dired-insert-headerline-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6031 (setq ange-ftp-dired-insert-headerline-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6032 (cons '(cms . ange-ftp-dired-cms-insert-headerline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6033 ange-ftp-dired-insert-headerline-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6034
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6035 (defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6036 "In dired, move to the first char of filename on this line."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6037 ;; This is the CMS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6038 (or eol (setq eol (progn (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6039 (let (case-fold-search)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6040 (beginning-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6041 (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6042 (goto-char (1+ (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6043 (if raise-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6044 (error "No file on this line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6045 nil))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6046
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6047 (or (assq 'cms ange-ftp-dired-move-to-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6048 (setq ange-ftp-dired-move-to-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6049 (cons '(cms . ange-ftp-dired-cms-move-to-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6050 ange-ftp-dired-move-to-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6051
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6052 (defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6053 ;; Assumes point is at beginning of filename.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6054 ;; So, it should be called only after (dired-move-to-filename t).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6055 ;; case-fold-search must be nil, at least for VMS.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6056 ;; On failure, signals an error or returns nil.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6057 ;; This is the CMS version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6058 (let ((opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6059 case-fold-search hidden)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6060 (or eol (setq eol (save-excursion (end-of-line) (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6061 (setq hidden (and selective-display
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6062 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6063 (search-forward "\r" eol t))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6064 (if hidden
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6065 (if no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6066 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6067 (error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6068 (substitute-command-keys
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6069 "File line is hidden, type \\[dired-hide-subdir] to unhide")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6070 (skip-chars-forward "-A-Z0-9$_" eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6071 (skip-chars-forward " " eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6072 (skip-chars-forward "-A-Z0-9$_" eol)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6073 (if (eq opoint (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6074 (if no-error
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6075 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6076 (error "No file on this line"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6077 (point)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6078
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6079 (or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6080 (setq ange-ftp-dired-move-to-end-of-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6081 (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6082 ange-ftp-dired-move-to-end-of-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6083
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6084 (defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6085 (if reverse
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6086 (if (string-match "-Z$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6087 (substring name 0 -2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6088 name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6089 (concat name "-Z")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6090
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6091 (or (assq 'cms ange-ftp-dired-compress-make-compressed-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6092 (setq ange-ftp-dired-compress-make-compressed-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6093 (cons '(cms . ange-ftp-cms-make-compressed-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6094 ange-ftp-dired-compress-make-compressed-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6095
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6096 (defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6097 (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6098 (and name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6099 (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6100 (concat (substring name 0 (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6101 "."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6102 (substring name (match-beginning 2) (match-end 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6103 name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6104
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6105 (or (assq 'cms ange-ftp-dired-get-filename-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6106 (setq ange-ftp-dired-get-filename-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6107 (cons '(cms . ange-ftp-dired-cms-get-filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6108 ange-ftp-dired-get-filename-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6109
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6110 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6111 ;;;; Finally provide package.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6112 ;;;; ------------------------------------------------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6113
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6114 ;; This is so that VC doesn't need to be hacked up. I think the fsf way is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6115 ;; a bit cleaner. (Forgive me, as I have sinned...) The great side-effect
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6116 ;; of this change is that ange-ftp will now autoload...even w/o being fully
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6117 ;; converted to use the filename-handler-alist. --Stig
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6118
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6119 ;; Turn off RCS/SCCS processing to save time.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6120 ;; This returns nil for any file name as argument.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6121 (put 'vc-registered 'ange-ftp 'null)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6122 ^L
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6123 ;;; Define ways of getting at unmodified Emacs primitives,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6124 ;;; turning off our handler.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6125
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6126 (defun ange-ftp-run-real-handler (operation args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6127 (let ((inhibit-file-name-handlers
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6128 (cons 'ange-ftp-hook-function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6129 (cons 'ange-ftp-completion-hook-function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6130 (and (eq inhibit-file-name-operation operation)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6131 inhibit-file-name-handlers))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6132 (inhibit-file-name-operation operation))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6133 (apply operation args)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6134
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6135 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6136 (defun ange-ftp-hook-function (operation &rest args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6137 (let ((fn (get operation 'ange-ftp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6138 (if fn (apply fn args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6139 (ange-ftp-run-real-handler operation args))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6140
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6141 ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6142 (or (assoc (car ange-ftp-path-format) file-name-handler-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6143 (setq file-name-handler-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6144 (cons (cons (car ange-ftp-path-format) 'ange-ftp-hook-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6145 file-name-handler-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6146
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6147 ;; ;;; This regexp recognizes and absolute filenames with only one component,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6148 ;; ;;; for the sake of hostname completion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6149 ;; ;;;###autoload
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6150 ;; (or (assoc "^/[^/:]*\\'" file-name-handler-alist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6151 ;; (setq file-name-handler-alist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6152 ;; (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6153 ;; file-name-handler-alist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6154
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6155 (provide 'ange-ftp)