wjc@ho5cad.ATT.COM (Bill Carpenter) (01/13/89)
I recently made some modest enhancements to "remote.el", a package
posted here a few months ago. The enchancements are summarized in the
comments near the top.
--
Bill Carpenter att!ho5cad!wjc or attmail!bill
;====================<remote.el>=======================================
;; Augmented to allow other types of networking ... for example, I have
;; implemented using DATAKIT(tm) "push" and "pull" commands. Which networking
;; to use is controlled by remote-preferred-network (default rcp).
;;
;; Mostly involved taking "hard-coded" stuff about rcp out and then
;; making (cond...) lists in a few places.
;;
;; An unrelated change was to make the code remember the originally
;; bound command when mucking with ^X-^F, etc. Before, it reverted to the
;; hard-coded commands on those keys (which was inconvenient if
;; you had rebound them for other purposes).
;;
;; BTW, this code was a pleasure to work with. Good modularity, etc.
;;
;; Jan 89, wjc@ho5cad.att.com (Bill Carpenter)
;;From raible@orville.nas.nasa.gov Wed Nov 23 18:57:08 1988
;;From: raible@orville.nas.nasa.gov (Eric L. Raible)
;;Newsgroups: comp.emacs
;;Subject: Re: ftp-find-file problems
;;Date: 23 Nov 88 02:31:29 GMT
;;Reply-To: raible@orville.nas.nasa.gov (Eric L. Raible)
;;Organization: NASA Ames Research Center, Moffett Field, CA
;;
;;I hacked Nick Tran's remote.el a while back, and have found it
;;quite useful. This code allows almost transparent file operations
;;to remote machines using rcp.
;;
;;Try it - you'll like it.
;; remote.el version 2.6
;;
;; Module to do remote editing via rcp. Assume .rhosts files are
;; set up properly on both machines.
;; Modeled after ftp.el by MLY.PREP.AI.MIT.EDU
;;
;; Nick Tran
;; University of Minnesota
;; Summer 87
;;
;; Almost complete rewrite. Added minor mode support, better
;; defaults, rewrote find-remote-file, wrote read-remote-file-name,
;; insert-remote-file, find-file, find-alternate-remote-file,
;; get-remote-file-or-buffer, get-remote-buffer, process-wait,
;; remote-rcp-error. Also general clean up, error handling, etc.
;; Eric Raible Wednesday Sept 5, 1988
;;
;; Automatically set major mode, added prefix arg support for most
;; file operations to toggle sense of remote editing.
;; Eric Raible Thursday October 6, 1988
;;
;; Manipulate buffer name more appropriately
;; Eric Raible Friday October 7, 1988
;;
;; For write-remote-file, allow default of file part of remote name.
;; Eric Raible Tuesday October 11, 1988
;;
;; Allow other networking types and implemented DATAKIT stuff.
;; Changed key-binding stuff to honor user's bindings.
;; Bill Carpenter, att!ho5cad!wjc, Sat Jan 7 15:06:52 EST 1989
(defvar default-remote-host "navier:"
"*The host to use for remote file operations when none other is appropriate.")
(defvar remote-preferred-network "rcp"
"*Preferred networking method for remote access. The following are implemented:
rcp remote copy via tcp/ip
dk push/pull via datakit
The default is \"rcp\".")
(defvar track-default-remote-host t
"*Controls whether default-remote-host is changed after reading a
remote file name. When non-nil, default-remote-host will have the
value of the last remote host read."
)
(make-variable-buffer-local 'buffer-remote-file-name)
(set-default 'buffer-remote-file-name "")
(make-variable-buffer-local 'remote-editing)
(defvar rcp (cond ((file-exists-p "/bin/rcp") "/bin/rcp")
((file-exists-p "/usr/bsd/rcp") "/usr/bsd/rcp")
(t "rcp")) "*Pathname of the TCP/IP rcp command")
;; these bojangles could be most anywhere on the machine
(defvar dkpush (cond
((file-exists-p "/usr/add-on/dkit/bin/push")
"/usr/add-on/dkit/bin/push")
((file-exists-p "/usr/local/bin/push") "/usr/local/bin/push")
((file-exists-p "/usr/lbin/push") "/usr/lbin/push")
((file-exists-p "/usr/bin/push") "/usr/bin/push")
(t "push")) "*Pathname of the DATAKIT push command")
(defvar dkpull (cond
((file-exists-p "/usr/add-on/dkit/bin/pull")
"/usr/add-on/dkit/bin/pull")
((file-exists-p "/usr/local/bin/pull") "/usr/local/bin/pull")
((file-exists-p "/usr/lbin/pull") "/usr/lbin/pull")
((file-exists-p "/usr/bin/pull") "/usr/bin/pull")
(t "pull")) "*Pathname of the DATAKIT push command")
(if (assoc 'remote-editing minor-mode-alist)
()
(setq minor-mode-alist (cons '(remote-editing " Remote") minor-mode-alist)))
(defun remote-editing (arg)
"Toggle remote-editing mode.
With arg, turn on remote editing mode iff arg is positive, otherwise
just toggle it.
In remote editing mode, the normal bindings for find-file,
find-file-read-only, find-alternate-file, save-buffer, write-file, and
insert-file are changed to operate on a remote system by default.
When remote editing, a prefix arg allows local file operations. When
not remote editing, a prefix arg allows remote file operations.
The networking method is controlled by remote-preferred-network. See
the documentation for that variable for a list of allowed networks.
It is assumed that permissions files are set up properly on both
machines."
(interactive "P")
(setq remote-editing
(if (null arg) (not remote-editing)
(> (prefix-numeric-value arg) 0)))
(set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
(global-set-key "\C-xr" 'remote-editing)
;; Macro used as front-end to normal file operation key bindings to
;; decide between local and remote modes. Automatically constructs doc
;; string and includes prefix arg to temporarily toggle sense of
;; remote-editing.
(defmacro def-local-or-remote (binding name remote defaultlocal)
(let ((r (symbol-name (eval remote)))
(computedlocal (or (key-binding binding) (eval defaultlocal)))
(l (symbol-name (or (key-binding binding) (eval defaultlocal)))))
(list 'progn
(list 'global-set-key binding (list 'quote name))
(list 'defun name '(arg)
(concat "Call either " r " or " l ".
If remote-editing (see also), call " r ",
else call " l ".
See also the documentation for " r "
and " l ".")
'(interactive "P")
(list 'call-interactively
(list 'if '(xor remote-editing arg)
remote
(list 'quote computedlocal)
))))))
(def-local-or-remote "\C-x\C-f" find-local-or-remote-file
'find-remote-file 'find-file)
(def-local-or-remote "\C-x\C-r" find-local-or-remote-file-read-only
'find-remote-file-read-only 'find-file-read-only)
(def-local-or-remote "\C-x\C-v" find-alternate-local-or-remote-file
'find-alternate-remote-file 'find-alternate-file)
(def-local-or-remote "\C-x\C-s" save-local-or-remote-buffer
'save-remote-buffer 'save-buffer)
(def-local-or-remote "\C-x\C-w" write-local-or-remote-file
'write-remote-file 'write-file)
(def-local-or-remote "\C-xi" insert-local-or-remote-file
'insert-remote-file 'insert-file)
(defun find-remote-file (host file)
"Edit remote file HOST:FILE (using networking).
This command is similiar to find-file, but uses networking to read the file from
a remote machine. Also see remote-editing."
(interactive (read-remote-file-name "Find remote file"))
(let ((buffer-or-file (get-remote-file-or-buffer host file "retrieve"))
local-file)
(if buffer-or-file
(if (bufferp buffer-or-file)
(switch-to-buffer buffer-or-file)
(setq local-file buffer-or-file)
(let ((buf (generate-new-buffer
(concat host (file-name-nondirectory file)))))
(switch-to-buffer buf)
(if (not (file-exists-p local-file))
(message "(New remote file)")
(insert-file-contents local-file)
(set-buffer-modified-p nil)
(delete-file local-file))
;; dynamic binding for normal-mode
(let ((buffer-file-name (concat host file)))
(normal-mode)
(remote-editing 1)
(setq buffer-remote-file-name buffer-file-name
buffer-offer-save t)))))))
(defun find-remote-file-read-only ()
"Edit remote file FILENAME, but mark buffer as read-only.
Also see find-remote-file and remote-editing."
(interactive)
(call-interactively 'find-remote-file)
(setq buffer-read-only t))
(defun find-alternate-remote-file ()
"Find alternate file using networking.
This command is similiar to find-alternate-file, but uses networking to
read the file from a remote machine. Also see remote-editing."
(interactive)
(and (buffer-modified-p)
(not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(buffer-name))))
(error "Aborted"))
(let ((obuf (current-buffer))
(oname (buffer-name)))
(rename-buffer " **lose**")
(unwind-protect
(apply 'find-remote-file
(read-remote-file-name "Find remote alternate file"))
(if (eq obuf (current-buffer))
(rename-buffer oname)
(kill-buffer obuf)))))
(defun save-remote-buffer ()
"Save a file using networking.
This command is similiar to save-buffer, but uses networking to write
the file back to a remote machine. Also see remote-editing."
(interactive)
(if (buffer-modified-p)
(if (zerop (length buffer-remote-file-name))
(call-interactively 'write-remote-file)
(do-write-remote-file buffer-remote-file-name))
(message "(No changes need to be saved)")))
(defun write-remote-file (host file)
"Write a file HOST:FILE using networking.
This command is similiar to write-file, but uses networking to write
the file back to a remote machine. Also see remote-editing."
(interactive (read-remote-file-name "Write remote file" 'no-file-ok))
(do-write-remote-file (concat host file)))
(defun insert-remote-file (host file)
"Insert a remote file HOST:FILE using networking.
This command is similiar to insert-file, but uses networking to read
the file from a remote machine. Also see remote-editing."
(interactive (read-remote-file-name "Insert remote file"))
(let ((f-or-b (get-remote-file-or-buffer host file "insert")))
(if f-or-b
(if (bufferp f-or-b)
(insert-buffer f-or-b)
(insert-file f-or-b)
(delete-file f-or-b)))))
;;;
;;; Internal routines
;;;
(defun do-write-remote-file (file)
(let* ((temp (concat "/tmp/" (buffer-name)))
(output (save-excursion
(prog1 (set-buffer (get-buffer-create "*Remote Cmd Messages*"))
(erase-buffer))))
(cursor-in-echo-area t)
time)
;; write-file doesn't quite do it.
(save-restriction
(widen)
(write-region (point-min) (point-max) temp nil 'no-message))
(message "Sending %s..." file)
(if (setq time (process-wait
;; form command based on network
(cond
((string-equal remote-preferred-network "dk")
(start-process "push" output
dkpush (host-part-only-nc file)
temp (file-name-directory (file-part-only file))))
(t ;; default is rcp
(start-process "rcp" output rcp temp file))
)
))
(progn
(if remote-editing
(let ((new-name (concat (host-part-only file)
(file-name-nondirectory (file-part-only file)))))
(or (get-buffer new-name) (rename-buffer new-name))
(set-buffer-modified-p nil)))
(setq buffer-remote-file-name file)
(message "%d bytes in %d seconds" (buffer-size) time)
(delete-file temp))
(remote-copy-error output buffer-remote-file-name "update"))))
(defun get-remote-file-or-buffer (host file message)
"Return a remote file as either a buffer or a file.
If the file HOST:FILE already has been read in, return the buffer
that contains it; otherwise try and network the file to the local machine.
If successful, return the local file name."
(let ((remote (concat host file))
(temp (concat "/tmp/" (file-name-nondirectory file)))
time)
(if (string= file (file-name-directory file))
(progn
(message "Remote directory listing not yet implemented")
nil)
(or (get-remote-buffer remote) ;; already exists
(let* ((output (save-excursion
(prog1 (set-buffer (get-buffer-create "*Remote Cmd Messages*"))
(erase-buffer))))
(cursor-in-echo-area t))
(message "Retrieving %s..." remote)
(if (setq time (process-wait
;; form command based on network
(cond
((string-equal remote-preferred-network "dk")
(start-process "pull" output
dkpull (host-part-only-nc remote)
(file-part-only remote) (file-name-directory temp)))
(t ;; default is rcp
(start-process "rcp" output rcp remote temp))
)
))
(progn
(message "%d bytes in %d seconds"
(nth 7 (file-attributes temp)) time)
temp)
(remote-copy-error output remote message)))))))
(defun get-remote-buffer (name)
(save-window-excursion
(let ((buffers (buffer-list)) found)
(while (and (not found) buffers)
(set-buffer (car buffers))
(if (string= name buffer-remote-file-name)
(setq found (car buffers)))
(setq buffers (cdr buffers)))
found)))
(defun read-remote-file-name (prompt &optional no-file-ok)
"Read a remote file specification, and return list (host file).
Prompting with PROMPT, read a string of the form host:file. The default
value is derived from the remote file name, or if there is none, then
from the global default (default-remote-host)."
(let* ((host (or (host-part-only buffer-remote-file-name)
default-remote-host))
(result (concat host (file-name-directory
(or (file-part-only buffer-remote-file-name)
""))))
(prompt (concat prompt " (host:file): "))
file)
(setq result (read-no-blanks-input prompt result))
(while (not (string-match (if no-file-ok
".+:"
".+:.+")
result))
(setq result (read-no-blanks-input prompt result)))
(setq host (host-part-only result)
file (file-part-only result))
(and track-default-remote-host
(setq default-remote-host host))
(list host
(if (or (null file) (string= file (file-name-directory file)))
(concat file (or (if (not (string= buffer-remote-file-name ""))
(file-name-nondirectory
(file-part-only buffer-remote-file-name)))
(file-part-only (buffer-name))
(buffer-name)))
file))))
(defun host-part-only (name)
(if (string-match ".+:" name)
(substring name 0 (match-end 0))))
(defun host-part-only-nc (name) ;; sans colon
(if (string-match ".+:" name)
(substring name 0 (- (match-end 0) 1))))
(defun file-part-only (name)
(if (string-match ".+:\\(.+\\)" name)
(substring name (match-beginning 1) (match-end 1))))
(defun xor (a b)
(eq (null a) (not (null b))))
(defun process-wait (proc)
(let ((time 0))
(while (eq (process-status proc) 'run)
(setq time (1+ time))
(sleep-for 1))
(if (and (eq (process-status proc) 'exit)
(eq (process-exit-status proc) 0))
time
nil)))
(defun remote-copy-error (buffer file-name message)
(save-window-excursion
(switch-to-buffer buffer)
(delete-other-windows)
(goto-char 1)
(insert (format "Unable to %s %s\n\n" message file-name))
(goto-char (point-max))
(message "Hit any character to continue")
(read-char)
(bury-buffer buffer)))
; (defun increment-version ()
; (interactive)
; (if (and (string= (user-login-name) "raible")
; (string= "remote.el" (buffer-name)))
; (save-excursion
; (goto-char (point-min))
; (end-of-line)
; (search-backward ".")
; (forward-char 1)
; (let ((minor (save-excursion (read (current-buffer)))))
; (kill-line)
; (insert (concat (1+ minor)))))))