home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / rpc-hm-1.0 / remote-lisp-interaction.el < prev    next >
Encoding:
Text File  |  1992-05-06  |  7.9 KB  |  244 lines
  1. ;Author: Eyvind Ness (eyvind) 
  2. ;Date:   Thursday, May 7 1992 08:42 GMT
  3. ;File:   /usr/local/gnu/emacs/elisp/site-extensions/remote-lisp-interaction.el
  4.  
  5. ;;;     Copyright (C) 1991, 1992 Eyvind Ness.
  6. ;;;
  7. ;;;     Permission to use, copy, modify, and distribute this software and its
  8. ;;;     documentation for non-commercial purposes and without fee is hereby
  9. ;;;     granted, provided that the above copyright notice appear in all copies
  10. ;;;     and that both the copyright notice and this permission notice appear in
  11. ;;;     supporting documentation. OECD Halden Reactor Project makes no
  12. ;;;     representations about the suitability of this software for any purpose.
  13. ;;;     It is provided "as is" without express or implied warranty.
  14. ;;;
  15. ;;;     OECD Halden Reactor Project disclaims all warranties with regard to this
  16. ;;;     software, including all implied warranties of merchantability and
  17. ;;;     fitness, and in no event shall OECD Halden Reactor Project be liable for
  18. ;;;     any special, indirect or consequential damages or any damages whatsoever
  19. ;;;     resulting from loss of use, data or profits, whether in an action of
  20. ;;;     contract, negligence or other tortious action, arising out of or in
  21. ;;;     connection with the use or performance of this software.
  22. ;;;
  23. ;;;
  24. ;;;     Eyvind Ness
  25. ;;;     Research Scientist
  26. ;;;     Control Room Systems Division
  27. ;;;     OECD Halden Reactor Project
  28. ;;;     Norway
  29. ;;;
  30. ;;;     Internet Email: eyvind@hrp.no
  31. ;;;     Voice: +47 9 183100
  32. ;;;     Fax: +47 9 187109
  33. ;;;     Surface mail: P.O. Box 173, N-1751 Halden, Norway
  34.  
  35. (require 'rpc-hm)
  36. (require 'gobble-whitespace)
  37. (condition-case c
  38.     (progn
  39.       (require 'completer)
  40.       (require 'ilisp)
  41.       (require 'ilisp-rpc-hm-mods))
  42.   (error
  43.    (message "Non-fatal error: Ignoring problems loading ILISP (%s)" c)))
  44. (require 'remote-lisp-documentation)
  45. (provide 'remote-lisp-interaction)
  46.  
  47.  
  48. (defvar rlm-with-transparent-signals nil
  49.   "If non-nil signals from rpc-hm will not be trapped by the functions
  50. in this package, but relayed, if that makes sense.
  51. Using a lexical binding is the recommended way to temporarily rebind
  52. this var to a specific value.")
  53.  
  54.  
  55. (defvar ilisp-use-rpc-hm-instead nil
  56.   "*Set to non-nil when using rpc-hm as a transport for ILISP.")
  57. (make-variable-buffer-local 'ilisp-use-rpc-hm-instead)
  58.  
  59.  
  60. (defun remote-lisp-mode-commands (map)
  61.   (define-key map "\C-hf" 'rld-describe-function)
  62.   (define-key map "\C-hv" 'rld-describe-variable)
  63.   (define-key map "\e\C-m" 'rpc-hm-next-host)
  64.   (define-key map "\e\C-x" 'rlm-lisp-send-defun)
  65.   ;; inherit a few nice things from ilisp:
  66.   (define-key map "\e\C-i" 'complete-lisp)
  67.   )
  68.     
  69.  
  70. (defun rlm-lisp-send-defun (&optional insertp)
  71.   ;; Evaluates expression surrounding point using
  72.   ;; rpc-hm-internal.
  73.   (interactive)
  74.   (let (result)
  75.     (save-excursion
  76.       ;; I'm not quite happy with mark-defun:
  77.       ;; (mark-defun)
  78.       (push-mark (point) 'no-message-please)
  79.       (end-of-defun)
  80.       (push-mark (point) 'no-message-please)
  81.       (forward-sexp -1)
  82.       (or noninteractive (message "RPC... "))
  83.       (setq result
  84.         (rpc-hm-internal
  85.          (rpc-hm-get-current-host)
  86.          (buffer-substring (region-beginning) (region-end))
  87.          nil ':any)))
  88.     (prog1
  89.     result
  90.       (cond (insertp
  91.          (insert (format "\n%s\n" result))
  92.          (or noninteractive (message "RPC... done.")))
  93.         (t
  94.          (or noninteractive (message "%s" result)))))))
  95.  
  96.  
  97. (defun rlm-eval-last-sexp (arg)
  98.   "Evaluate sexp before point; print value in minibuffer.
  99. With argument, print output into current buffer."
  100.   (interactive "P")
  101.   (or noninteractive (message "RPC... "))
  102.   (condition-case c
  103.       (let ((result
  104.          (rpc-hm-internal
  105.           (rpc-hm-get-current-host)
  106.           (buffer-substring
  107.            (let ((stab (syntax-table)))
  108.          (unwind-protect
  109.               (save-excursion
  110.             (set-syntax-table rpc-hm-lisp-mode-syntax-table)
  111.             (forward-sexp -1)
  112.             (point))
  113.            (set-syntax-table stab)))
  114.            (point))
  115.           nil
  116.           ':any)))
  117.     (prog1 
  118.         result
  119.       (cond (arg
  120.          (let ((i 2) (all-ret-vals (rpc-hm-reparse-ans)))
  121.            (or (bolp) (insert "\n"))
  122.            (while (< i 3)
  123.              ;; the output streams are now concatenated, so there is
  124.              ;; really no need to loop any longer.
  125.              (insert (rpc-hm-read-from-string (elt all-ret-vals i)))
  126.              (setq i (1+ i)))
  127.            (or (bolp) (insert "\n"))
  128.            (insert (elt all-ret-vals 1) "\n"))
  129.          (or noninteractive (message "RPC... done.")))
  130.         (t
  131.          (or noninteractive (message "%s" result))))))
  132.     (rpc-hm-network-condition
  133.      (if rlm-with-transparent-signals
  134.      (signal (car c) (cdr c))
  135.      (let ((ctype (car c))
  136.            (simple-errmess
  137.         (and (= (length (cdr c)) 1)
  138.              (stringp (car (cdr c)))
  139.              (car (cdr c))))
  140.            (cdata (format "%s" (cdr c))))
  141.        (if (and (not noninteractive)
  142.             (or (> (length cdata) (screen-width))
  143.             (string-match "\n" cdata)))
  144.            (progn
  145.          (with-output-to-temp-buffer "*RPC HM Errors*"
  146.            (save-excursion
  147.              (set-buffer standard-output)
  148.              (insert (get ctype 'error-message) ":\n\n")
  149.              (insert (or simple-errmess cdata)))
  150.            (rld-print-help-return-message)))
  151.            (progn 
  152.          (message "%s" (or simple-errmess cdata)))))))))
  153.  
  154.  
  155. (defun rlm-eval-print-last-sexp ()
  156.   "Same as rlm-eval-last-sexp, but also inserts the returned values
  157. into the current buffer."
  158.   (interactive)
  159.   (rlm-eval-last-sexp t))
  160.  
  161.  
  162. (defun rlm-eval-current-buffer (arg)
  163.   "Sends the top-level forms in the current buffer to remote host using
  164. rpc-hm-internal. With prefix ARG, insert vals into the current buffer as
  165. you go."
  166.   (interactive "P")
  167.   (let ((rlm-with-transparent-signals t))
  168.     ;; We don't want to go on evaluating forms if a condition is raised,
  169.     ;; so make sure signals from rpc-hm are transparent during the body
  170.     ;; of this LET.
  171.     (save-excursion
  172.       (goto-char (point-min))
  173.       (gw-skip-blank-lines-and-comments)
  174.       (while (not (eobp))
  175. ;;;    (message "%s" (rlm-lisp-send-defun)) (end-of-defun)
  176.     (forward-sexp 1) (message "%s" (rlm-eval-last-sexp arg))
  177.     (gw-skip-blank-lines-and-comments)))))
  178.  
  179.  
  180. ;;;
  181. ;;; Some utils for interactive mode (very much like Common-Lisp mode).
  182.  
  183. (defvar lispm-mode-map () "")
  184.  
  185. (if lispm-mode-map
  186.     ()
  187.   (setq lispm-mode-map (make-sparse-keymap))
  188.   (lisp-mode-commands lispm-mode-map)
  189.   (remote-lisp-mode-commands lispm-mode-map)
  190.   (define-key lispm-mode-map "\C-j" 'rlm-eval-print-last-sexp))
  191.  
  192.  
  193. (defvar lispm-mode-hook nil
  194.   "If non-nil a function to be called when entering lispm-mode.")
  195.  
  196.  
  197. (defun lispm-mode (&optional host)
  198.   "Major mode for interacting with a remote Lisp process.
  199. Commands:
  200. Delete converts tabs to spaces as it moves back.
  201. Blank lines separate paragraphs.  Semicolons start comments.
  202. \\{lispm-mode-map}
  203. Note that `run-lisp' may be used either to start an inferior Lisp job
  204. or to switch back to an existing one."
  205.  
  206.   (interactive)
  207.   (kill-all-local-variables)
  208.   (make-local-variable 'global-mode-string)
  209.   (make-local-variable 'ilisp-complete-command)
  210.   (setq ilisp-complete-command 
  211.     "(ILISP:ilisp-matching-symbols \"%s\" \"%s\" %s %s %s)")
  212.   (make-local-variable 'ilisp-symbol-delimiters)
  213.   (setq ilisp-symbol-delimiters "^ \t\n\('\"#.\)<>")
  214.   (setq ilisp-use-rpc-hm-instead t)
  215.   (use-local-map lispm-mode-map)
  216.   (lisp-mode-variables t)
  217.   (setq major-mode 'lispm-mode)
  218.   (setq mode-name "Lispm Mode")
  219.   (set-syntax-table rpc-hm-lisp-mode-syntax-table)
  220.   (rpc-hm-set-current-host host)
  221.   (rpc-hm-update-mode-line-if-convenient)
  222.   (run-hooks 'lispm-mode-hook))
  223.  
  224.  
  225. (defun rlm-run-remote-lisp (host)
  226.   "Switch to an interactive buffer virtually connected to a remote lisp
  227. interpreter on HOST, a remote lisp machine."
  228.   (interactive
  229.    (list
  230.     (intern
  231.      (let ((completion-ignore-case t))
  232.        (completing-read
  233.     "Remote host: "
  234.     (mapcar
  235.      (function (lambda (el) (list (symbol-name (car el)))))
  236.      rpc-hm-host-db)
  237.     (function identity) 'must-exist
  238.     (prin1-to-string (rpc-hm-get-current-host)))))))
  239.   (switch-to-buffer
  240.    (generate-new-buffer "*remote-lisp-interaction*"))
  241.   (lispm-mode host)
  242.   (or rpc-hm-startup-message-displayed-p
  243.       (rpc-hm-display-startup-message)))
  244.