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