|
0
|
1 ;; remote.el version 2.6
|
|
|
2 ;;
|
|
|
3 ;; Module to do remote editing via rcp. Assume .rhosts files are
|
|
|
4 ;; set up properly on both machines.
|
|
|
5 ;; Modeled after ftp.el by MLY.PREP.AI.MIT.EDU
|
|
|
6 ;;
|
|
|
7 ;; Nick Tran
|
|
|
8 ;; University of Minnesota
|
|
|
9 ;; Summer 87
|
|
|
10 ;;
|
|
|
11 ;;; Synched up with: Not in FSF.
|
|
|
12
|
|
|
13 ;; Almost complete rewrite. Added minor mode support, better
|
|
|
14 ;; defaults, rewrote find-remote-file, wrote read-remote-file-name,
|
|
|
15 ;; insert-remote-file, find-file, find-alternate-remote-file,
|
|
|
16 ;; get-remote-file-or-buffer, get-remote-buffer, process-wait,
|
|
|
17 ;; remote-rcp-error. Also general clean up, error handling, etc.
|
|
|
18 ;; Eric Raible Wednesday Sept 5, 1988
|
|
|
19 ;;
|
|
|
20 ;; Automatically set major mode, added prefix arg support for most
|
|
|
21 ;; file operations to toggle sense of remote editing.
|
|
|
22 ;; Eric Raible Thursday October 6, 1988
|
|
|
23 ;;
|
|
|
24 ;; Manipulate buffer name more appropriately
|
|
|
25 ;; Eric Raible Friday October 7, 1988
|
|
|
26 ;;
|
|
|
27 ;; For write-remote-file, allow default of file part of remote name.
|
|
|
28 ;; Eric Raible Tuesday October 11, 1988
|
|
|
29
|
|
|
30 (defvar default-remote-host "navier:"
|
|
|
31 "The host to use for remote file operations when none other is appropriate.")
|
|
|
32
|
|
|
33 (defvar track-default-remote-host t
|
|
|
34 "Controls whether default-remote-host is changed after reading a remote file name.
|
|
|
35 When non-nil, default-remote-host will have the value of the last remote host read.")
|
|
|
36
|
|
|
37 (make-variable-buffer-local 'buffer-remote-file-name)
|
|
|
38 (set-default 'buffer-remote-file-name "")
|
|
|
39 (make-variable-buffer-local 'remote-editing)
|
|
|
40
|
|
|
41 (defvar rcp (cond ((file-exists-p "/bin/rcp") "/bin/rcp")
|
|
|
42 ((file-exists-p "/usr/bsd/rcp") "/usr/bsd/rcp")
|
|
|
43 (t "rcp")))
|
|
|
44
|
|
|
45 (if (assoc 'remote-editing minor-mode-alist)
|
|
|
46 ()
|
|
|
47 (setq minor-mode-alist (cons '(remote-editing " Remote") minor-mode-alist)))
|
|
|
48
|
|
|
49 (defun remote-editing (arg)
|
|
|
50 "Toggle remote-editing mode.
|
|
|
51 With arg, turn on remote editing mode iff arg is positive, otherwise just toggle it.
|
|
|
52
|
|
|
53 In remote editing mode, the normal bindings for find-file,
|
|
|
54 find-file-read-only, find-alternate-file, save-buffer, write-file,
|
|
|
55 and insert-file are changed to operate on a remote system by default.
|
|
|
56
|
|
|
57 When remote editing, a prefix arg allows local file operations. When not
|
|
|
58 remote editing, a prefix arg allows remote file operations.
|
|
|
59
|
|
|
60 It is assumed that .rhosts files are set up properly on both machines."
|
|
|
61 (interactive "P")
|
|
|
62 (setq remote-editing
|
|
|
63 (if (null arg) (not remote-editing)
|
|
|
64 (> (prefix-numeric-value arg) 0)))
|
|
|
65 (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
|
|
|
66
|
|
|
67 (global-set-key "\C-xr" 'remote-editing)
|
|
|
68
|
|
|
69 ;;;
|
|
|
70 ;;; Macro used as front-end to normal file operation key bindings to decide between
|
|
|
71 ;;; local and remote modes. Automatically constructs doc string and includes prefix arg
|
|
|
72 ;;; to temporarily toggle sense of remote-editing.
|
|
|
73 ;;;
|
|
|
74 (defmacro def-local-or-remote (binding name remote local)
|
|
|
75 (let ((r (symbol-name (eval remote)))
|
|
|
76 (l (symbol-name (eval local))))
|
|
|
77 (list 'progn
|
|
|
78 (list 'global-set-key binding (list 'quote name))
|
|
|
79 (list 'defun name '(arg)
|
|
|
80 (concat "Call either " r " or " l ".
|
|
|
81 If remote-editing (which see), call " r ", else call " l ".
|
|
|
82
|
|
|
83 See also the documentation for " r " and " l ".")
|
|
|
84 '(interactive "P")
|
|
|
85 (list 'call-interactively
|
|
|
86 (list 'if '(xor remote-editing arg)
|
|
|
87 remote
|
|
|
88 local))))))
|
|
|
89
|
|
|
90 (def-local-or-remote "\C-x\C-f" find-local-or-remote-file 'find-remote-file 'find-file)
|
|
|
91 (def-local-or-remote "\C-x\C-r" find-local-or-remote-file-read-only 'find-remote-file-read-only 'find-file-read-only)
|
|
|
92 (def-local-or-remote "\C-x\C-v" find-alternate-local-or-remote-file 'find-alternate-remote-file 'find-alternate-file)
|
|
|
93 (def-local-or-remote "\C-x\C-s" save-local-or-remote-buffer 'save-remote-buffer 'save-buffer)
|
|
|
94 (def-local-or-remote "\C-x\C-w" write-local-or-remote-file 'write-remote-file 'write-file)
|
|
|
95 (def-local-or-remote "\C-xi" insert-local-or-remote-file 'insert-remote-file 'insert-file)
|
|
|
96
|
|
|
97 (defun find-remote-file (host file)
|
|
|
98 "Edit remote file HOST:FILE (using rcp).
|
|
|
99 This command is similiar to find-file, but uses rcp to read the file from
|
|
|
100 a remote machine. Also see remote-editing."
|
|
|
101 (interactive (read-remote-file-name "Find remote file"))
|
|
|
102 (let ((buffer-or-file (get-remote-file-or-buffer host file "retrieve"))
|
|
|
103 local-file)
|
|
|
104 (if buffer-or-file
|
|
|
105 (if (bufferp buffer-or-file)
|
|
|
106 (switch-to-buffer buffer-or-file)
|
|
|
107 (setq local-file buffer-or-file)
|
|
|
108 (let ((buf (generate-new-buffer
|
|
|
109 (concat host (file-name-nondirectory file)))))
|
|
|
110 (switch-to-buffer buf)
|
|
|
111 (if (not (file-exists-p local-file))
|
|
|
112 (message "(New remote file)")
|
|
|
113 (insert-file-contents local-file)
|
|
|
114 (set-buffer-modified-p nil)
|
|
|
115 (delete-file local-file))
|
|
|
116 ;; dynamic binding for normal-mode
|
|
|
117 (let ((buffer-file-name (concat host file)))
|
|
|
118 (normal-mode)
|
|
|
119 (remote-editing 1)
|
|
|
120 (setq buffer-remote-file-name buffer-file-name
|
|
|
121 buffer-offer-save t)))))))
|
|
|
122
|
|
|
123 (defun find-remote-file-read-only ()
|
|
|
124 "Edit remote file FILENAME, but mark buffer as read-only.
|
|
|
125 Also see find-remote-file and remote-editing."
|
|
|
126 (interactive)
|
|
|
127 (call-interactively 'find-remote-file)
|
|
|
128 (setq buffer-read-only t))
|
|
|
129
|
|
|
130 (defun find-alternate-remote-file ()
|
|
|
131 "Find alternate file using rcp.
|
|
|
132 This command is similiar to find-alternate-file, but uses rcp to read the file from
|
|
|
133 a remote machine. Also see remote-editing."
|
|
|
134 (interactive)
|
|
|
135 (and (buffer-modified-p)
|
|
|
136 (not buffer-read-only)
|
|
|
137 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
|
|
|
138 (buffer-name))))
|
|
|
139 (error "Aborted"))
|
|
|
140 (let ((obuf (current-buffer))
|
|
|
141 (oname (buffer-name)))
|
|
|
142 (rename-buffer " **lose**")
|
|
|
143 (unwind-protect
|
|
|
144 (apply 'find-remote-file
|
|
|
145 (read-remote-file-name "Find remote alternate file"))
|
|
|
146 (if (eq obuf (current-buffer))
|
|
|
147 (rename-buffer oname)
|
|
|
148 (kill-buffer obuf)))))
|
|
|
149
|
|
|
150 (defun save-remote-buffer ()
|
|
|
151 "Save a file using rcp.
|
|
|
152 This command is similiar to save-buffer, but uses rcp to write the file back
|
|
|
153 to a remote machine. Also see remote-editing."
|
|
|
154 (interactive)
|
|
|
155 (if (buffer-modified-p)
|
|
|
156 (if (zerop (length buffer-remote-file-name))
|
|
|
157 (call-interactively 'write-remote-file)
|
|
|
158 (do-write-remote-file buffer-remote-file-name))
|
|
|
159 (message "(No changes need to be saved)")))
|
|
|
160
|
|
|
161 (defun write-remote-file (host file)
|
|
|
162 "Write a file HOST:FILE using rcp.
|
|
|
163 This command is similiar to write-file, but uses rcp to write the file back
|
|
|
164 to a remote machine. Also see remote-editing."
|
|
|
165 (interactive (read-remote-file-name "Write remote file" 'no-file-ok))
|
|
|
166 (do-write-remote-file (concat host file)))
|
|
|
167
|
|
|
168 (defun insert-remote-file (host file)
|
|
|
169 "Insert a remote file HOST:FILE using rcp.
|
|
|
170 This command is similiar to insert-file, but uses rcp to read the file from
|
|
|
171 a remote machine. Also see remote-editing."
|
|
|
172 (interactive (read-remote-file-name "Insert remote file"))
|
|
|
173 (let ((f-or-b (get-remote-file-or-buffer host file "insert")))
|
|
|
174 (if f-or-b
|
|
|
175 (if (bufferp f-or-b)
|
|
|
176 (insert-buffer f-or-b)
|
|
|
177 (insert-file f-or-b)
|
|
|
178 (delete-file f-or-b)))))
|
|
|
179
|
|
|
180 ;;;
|
|
|
181 ;;; Internal routines
|
|
|
182 ;;;
|
|
|
183
|
|
|
184 (defun do-write-remote-file (file)
|
|
|
185 (let* ((temp (concat "/tmp/" (buffer-name)))
|
|
|
186 (output (save-excursion
|
|
|
187 (prog1 (set-buffer (get-buffer-create "*Rcp Output*"))
|
|
|
188 (erase-buffer))))
|
|
|
189 (cursor-in-echo-area t)
|
|
|
190 time)
|
|
|
191 ;; write-file doesn't quite do it.
|
|
|
192 (save-restriction
|
|
|
193 (widen)
|
|
|
194 (write-region (point-min) (point-max) temp nil 'no-message))
|
|
|
195 (message "Sending %s..." file)
|
|
|
196 (if (setq time (process-wait (start-process "rcp" output rcp temp file)))
|
|
|
197 (progn
|
|
|
198 (if remote-editing
|
|
|
199 (let ((new-name (concat (host-part-only file)
|
|
|
200 (file-name-nondirectory (file-part-only file)))))
|
|
|
201 (or (get-buffer new-name) (rename-buffer new-name))
|
|
|
202 (set-buffer-modified-p nil)))
|
|
|
203 (setq buffer-remote-file-name file)
|
|
|
204 (message "%d bytes in %d seconds" (buffer-size) time)
|
|
|
205 (delete-file temp))
|
|
|
206 (remote-rcp-error output buffer-remote-file-name "update"))))
|
|
|
207
|
|
|
208 (defun get-remote-file-or-buffer (host file message)
|
|
|
209 "Return a remote file as either a buffer or a file.
|
|
|
210 If the file HOST:FILE already has been read in, return the buffer
|
|
|
211 that contains it; otherwise try and rcp the file to the local machine.
|
|
|
212 If successful, return the local file name."
|
|
|
213 (let ((remote (concat host file))
|
|
|
214 (temp (concat "/tmp/" (file-name-nondirectory file)))
|
|
|
215 time)
|
|
|
216 (if (string= file (file-name-directory file))
|
|
|
217 (progn
|
|
|
218 (message "Remote directory listing not yet implemented")
|
|
|
219 nil)
|
|
|
220 (or (get-remote-buffer remote) ;; already exists
|
|
|
221 (let* ((output (save-excursion
|
|
|
222 (prog1 (set-buffer (get-buffer-create "*Rcp Output*"))
|
|
|
223 (erase-buffer))))
|
|
|
224 (cursor-in-echo-area t))
|
|
|
225 (message "Retrieving %s..." remote)
|
|
|
226 (if (setq time (process-wait (start-process "rcp" output rcp remote temp)))
|
|
|
227 (progn
|
|
|
228 (message "%d bytes in %d seconds"
|
|
|
229 (nth 7 (file-attributes temp)) time)
|
|
|
230 temp)
|
|
|
231 (remote-rcp-error output remote message)))))))
|
|
|
232
|
|
|
233 (defun get-remote-buffer (name)
|
|
|
234 (save-window-excursion
|
|
|
235 (let ((buffers (buffer-list)) found)
|
|
|
236 (while (and (not found) buffers)
|
|
|
237 (set-buffer (car buffers))
|
|
|
238 (if (string= name buffer-remote-file-name)
|
|
|
239 (setq found (car buffers)))
|
|
|
240 (setq buffers (cdr buffers)))
|
|
|
241 found)))
|
|
|
242
|
|
|
243 (defun read-remote-file-name (prompt &optional no-file-ok)
|
|
|
244 "Read a remote file specification, and return list (host file).
|
|
|
245 Prompting with PROMPT, read a string of the form host:file. The default
|
|
|
246 value is derived from the remote file name, or if there is none, then
|
|
|
247 from the global default (default-remote-host)."
|
|
|
248 (let* ((host (or (host-part-only buffer-remote-file-name)
|
|
|
249 default-remote-host))
|
|
|
250 (result (concat host (file-name-directory
|
|
|
251 (or (file-part-only buffer-remote-file-name)
|
|
|
252 ""))))
|
|
|
253 (prompt (concat prompt " (host:file): "))
|
|
|
254 file)
|
|
|
255 (setq result (read-no-blanks-input prompt result))
|
|
|
256 (while (not (string-match (if no-file-ok
|
|
|
257 ".+:"
|
|
|
258 ".+:.+")
|
|
|
259 result))
|
|
|
260 (setq result (read-no-blanks-input prompt result)))
|
|
|
261 (setq host (host-part-only result)
|
|
|
262 file (file-part-only result))
|
|
|
263 (and track-default-remote-host
|
|
|
264 (setq default-remote-host host))
|
|
|
265 (list host
|
|
|
266 (if (or (null file) (string= file (file-name-directory file)))
|
|
|
267 (concat file (or (if (not (string= buffer-remote-file-name ""))
|
|
|
268 (file-name-nondirectory
|
|
|
269 (file-part-only buffer-remote-file-name)))
|
|
|
270 (file-part-only (buffer-name))
|
|
|
271 (buffer-name)))
|
|
|
272 file))))
|
|
|
273
|
|
|
274 (defun host-part-only (name)
|
|
|
275 (if (string-match ".+:" name)
|
|
|
276 (substring name 0 (match-end 0))))
|
|
|
277
|
|
|
278 (defun file-part-only (name)
|
|
|
279 (if (string-match ".+:\\(.+\\)" name)
|
|
|
280 (substring name (match-beginning 1) (match-end 1))))
|
|
|
281
|
|
|
282 (defun xor (a b)
|
|
|
283 (eq (null a) (not (null b))))
|
|
|
284
|
|
|
285 (defun process-wait (proc)
|
|
|
286 (let ((time 0))
|
|
|
287 (while (eq (process-status proc) 'run)
|
|
|
288 (setq time (1+ time))
|
|
|
289 (sleep-for 1))
|
|
|
290 (if (and (eq (process-status proc) 'exit)
|
|
|
291 (eq (process-exit-status proc) 0))
|
|
|
292 time
|
|
|
293 nil)))
|
|
|
294
|
|
|
295 (defun remote-rcp-error (buffer file-name message)
|
|
|
296 (save-window-excursion
|
|
|
297 (switch-to-buffer buffer)
|
|
|
298 (delete-other-windows)
|
|
|
299 (goto-char 1)
|
|
|
300 (insert (format "Unable to %s %s\n\n" message file-name))
|
|
|
301 (goto-char (point-max))
|
|
|
302 (message "Hit any character to continue")
|
|
|
303 (read-char)
|
|
|
304 (bury-buffer buffer)))
|
