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 / ilisp-rpc-hm-mods.el < prev    next >
Encoding:
Text File  |  1992-05-05  |  4.4 KB  |  119 lines
  1. ;Author: Eyvind Ness (eyvind) 
  2. ;Date:   Wednesday, May 6 1992 12:33 GMT
  3. ;File:   /usr/local/gnu/emacs/elisp/site-extensions/ilisp-rpc-hm-mods.el
  4.  
  5. ;;;
  6. ;;; Mods to have ILISP functionality with rpc-hm.
  7.  
  8. (require 'ilisp)
  9. (provide 'ilisp-rpc-hm-mods)
  10.  
  11. ;;;   (WITH-FTP-FILE-ACCESS-ENV (:HOST-NAME "snapp"
  12. ;;;                                         :USER
  13. ;;;                                         "eyvind"
  14. ;;;                                         :PW
  15. ;;;                                         "xxx")
  16. ;;;     (CAREFUL-EVAL
  17. ;;;      (COMPILE-FILE
  18. ;;;       (PARSE-NAMESTRING
  19. ;;;        "/usr/local/gnu/emacs/elisp/ilisp-4.11/clisp.lisp"
  20. ;;;        "snapp")
  21. ;;;       :OUTPUT-FILE
  22. ;;;       (PARSE-NAMESTRING
  23. ;;;        "/usr/local/gnu/emacs/elisp/ilisp-4.11/clisp.xld"
  24. ;;;        "snapp")
  25. ;;;       :LOAD
  26. ;;;       T)))
  27. ;;;
  28. ;;;   << While compiling ILISP-DOCUMENTATION >>
  29. ;;;    (EQ (ELT TYPE 0) #\() should probably use EQL instead.
  30. ;;;   ; Loading snapp: /usr/local/gnu/emacs/elisp/ilisp-4.11/clisp.xld into package USER
  31. ;;;   (T #FS::UNIX-UCB-PATHNAME "snapp: /usr/local/gnu/emacs/elisp/ilisp-4.11/clisp.xld")
  32. ;;;
  33. ;;;
  34. ;;;   (insert (ilisp-value 'ilisp-complete-command))
  35. ;;;
  36. ;;;   ex.
  37. ;;;
  38. ;;;   (ILISP:ilisp-matching-symbols "with-" "user" t nil nil)
  39. ;;;    => (("with-open-file-case") ("with-open-file-search") ("with-timeout") ("with-stack-list") ("with-input-editing") ("with-lisp-mode") ("with-common-lisp-on") ("with-zetalisp-on") ("with-open-stream-case") ("with-stack-list*") ("with-self-variables-bound") ("with-lock") ("with-open-file-retry") ("with-open-stream") ("with-output-to-string") ("with-open-file") ("with-input-from-string") ("with-slots") ("with-added-methods") ("with-accessors") ("with-ftp-file-access-env") ("with-errors-and-output-trapped"))
  40.  
  41.  
  42. ;;;
  43. ;;; Need to redefine ilisp-send. The redef is backward compatible with
  44. ;;; original 4.11 def.
  45.  
  46. (defun ilisp-send (string &optional message status and-go handler)
  47.   "Send STRING to the ILISP buffer, print MESSAGE set STATUS and
  48. return the result if AND-GO is NIL, otherwise switch to ilisp if
  49. and-go is T and show message and results.  If AND-GO is 'dispatch,
  50. then the command will be executed without waiting for results.  If
  51. AND-GO is 'call, then a call will be generated. If this is the first
  52. time an ilisp command has been executed, the lisp will also be
  53. initialized from the files in ilisp-load-inits.  If there is an error,
  54. comint-errorp will be T and it will be handled by HANDLER."
  55.   
  56.   (if (and (boundp 'ilisp-use-rpc-hm-instead) ilisp-use-rpc-hm-instead)
  57.       (let ((result
  58.          (progn
  59.            (rpc-hm-internal
  60.         (rpc-hm-get-current-host) string
  61.         ;; e.g. "(ILISP:ilisp-matching-symbols \"with-\" \"user\" t nil nil)"
  62.         nil ':any)
  63.            (rpc-hm-reparse-ans))))
  64.     (concat
  65.      (substring (rpc-hm-read-from-string (car (cdr (cdr result)))) 1)
  66.      "\n" (car (cdr result))))
  67.       
  68.       (ilisp-init t)
  69.       (let ((process (ilisp-process))
  70.         (dispatch (eq and-go 'dispatch)))
  71.     (if message
  72.         (message "%s" (if dispatch
  73.                   (concat "Started " message)
  74.                   message)))
  75.     ;; No completion table
  76.     (setq ilisp-original nil)
  77.     (if (memq and-go '(t call))
  78.         (progn (comint-send process string nil nil status message handler)
  79.            (if (eq and-go 'call)
  80.                (call-defun-lisp nil)
  81.                (switch-to-lisp t t))
  82.            nil)
  83.         (let* ((save (ilisp-value 'ilisp-save-command t))
  84.            (result
  85.             (comint-send 
  86.              process
  87.              (if save (format save string) string)
  88.              ;; Interrupt without waiting
  89.              t (if (not dispatch) 'wait) status message handler)))
  90.           (if save 
  91.           (comint-send
  92.            process
  93.            (ilisp-value 'ilisp-restore-command t)
  94.            t nil 'restore "Restore" t t))
  95.           (if (not dispatch)
  96.           (progn
  97.             (while (not (cdr result))
  98.               (sit-for 0)
  99.               (accept-process-output))
  100.             (comint-remove-whitespace (car result)))))))))
  101.  
  102. ;;;
  103. ;;; Unfortunately, the prevailing assumption in ILISP is that there must
  104. ;;; be an Emacs subprocess associated with everything, so this need
  105. ;;; redefinition, too. It backward compatible with the original 4-11
  106. ;;; definition.
  107.  
  108. (defun ilisp-buffer ()
  109.   "Return the current ILISP buffer."
  110.   (if (memq major-mode ilisp-modes)
  111.       (current-buffer)
  112.       (let ((buffer 
  113.          (if ilisp-buffer (get-buffer ilisp-buffer))))
  114.     (or (and (boundp 'ilisp-use-rpc-hm-instead)
  115.          ilisp-use-rpc-hm-instead
  116.          (current-buffer))
  117.         buffer
  118.         (error "You must start an inferior LISP with run-ilisp.")))))
  119.