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-documentation.el < prev    next >
Encoding:
Text File  |  1992-05-06  |  6.0 KB  |  183 lines
  1. ;Author: Eyvind Ness (eyvind) 
  2. ;Date:   Thursday, May 7 1992 07:29 GMT
  3. ;File:   /usr/local/gnu/emacs/elisp/site-extensions/remote-lisp-documentation.el
  4.  
  5. ;;;
  6. ;;; This is a GNU Emacs interface to on-line documentation of Lisp
  7. ;;; functions on a remote documentation server host using a general
  8. ;;; RPC-based protocol. Convenient for use inside inferior-lisp-mode to
  9. ;;; have easy, single-keystroke access to the Common Lisp documentation
  10. ;;; of variables and functions just as on Lispms with C-D and C-A.
  11.  
  12. ;;;     Copyright (C) 1991, 1992 Eyvind Ness.
  13. ;;;
  14. ;;;     Permission to use, copy, modify, and distribute this software and its
  15. ;;;     documentation for non-commercial purposes and without fee is hereby
  16. ;;;     granted, provided that the above copyright notice appear in all copies
  17. ;;;     and that both the copyright notice and this permission notice appear in
  18. ;;;     supporting documentation. OECD Halden Reactor Project makes no
  19. ;;;     representations about the suitability of this software for any purpose.
  20. ;;;     It is provided "as is" without express or implied warranty.
  21. ;;;
  22. ;;;     OECD Halden Reactor Project disclaims all warranties with regard to this
  23. ;;;     software, including all implied warranties of merchantability and
  24. ;;;     fitness, and in no event shall OECD Halden Reactor Project be liable for
  25. ;;;     any special, indirect or consequential damages or any damages whatsoever
  26. ;;;     resulting from loss of use, data or profits, whether in an action of
  27. ;;;     contract, negligence or other tortious action, arising out of or in
  28. ;;;     connection with the use or performance of this software.
  29. ;;;
  30. ;;;
  31. ;;;     Eyvind Ness
  32. ;;;     Research Scientist
  33. ;;;     Control Room Systems Division
  34. ;;;     OECD Halden Reactor Project
  35. ;;;     Norway
  36. ;;;
  37. ;;;     Internet Email: eyvind@hrp.no
  38. ;;;     Voice: +47 9 183100
  39. ;;;     Fax: +47 9 187109
  40. ;;;     Surface mail: P.O. Box 173, N-1751 Halden, Norway
  41.  
  42. (require 'rpc-hm)
  43. (provide 'remote-lisp-documentation)
  44.  
  45.     
  46. (defun rld-print-help-return-message ()
  47.   ;; simplified, bug-free (?) version of `print-help-return-message'
  48.   (message
  49.    (substitute-command-keys
  50.     (if (one-window-p t)
  51.     (if pop-up-windows
  52.         "Type \\[delete-other-windows] to remove help window."
  53.         "Type \\[switch-to-buffer] RET to remove help window.")
  54.     "Type \\[switch-to-buffer-other-window] RET to restore old contents of help window."))))
  55.  
  56. (defun rld-function-called-at-point ()
  57.   (condition-case ()
  58.       (save-excursion
  59.     (save-restriction
  60.       (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
  61.       (backward-up-list 1)
  62.       (forward-char 1)
  63.       (let (obj)
  64.         (setq obj (read (current-buffer)))
  65.         (and (symbolp obj) obj))))
  66.     (error nil)))
  67.  
  68.  
  69. (defun rld-variable-at-point ()
  70.   (condition-case ()
  71.       (save-excursion
  72.     (forward-sexp -1)
  73.     (skip-chars-forward "'")
  74.     (let ((obj (read (current-buffer))))
  75.       (and (symbolp obj) obj)))
  76.     (error nil)))
  77.  
  78.  
  79. (defun rld-describe-function (function &optional doc-host no-display)
  80.   "Display the documentation of FUNCTION [supplied by DOC-HOST].
  81. If optional third arg NO-DISPLAY is non-nil, the doc is not displayed in
  82. a separate buffer."
  83.   
  84.   (interactive
  85.    (let ((fn (rld-function-called-at-point))
  86.      (enable-recursive-minibuffers t)         
  87.      val)
  88.      (setq
  89.       val
  90.       (completing-read
  91.        (if fn (format "Describe function (default %s): " fn)
  92.      "Describe function: ")
  93.        obarray 'fboundp nil))
  94.      (list (if (equal val "") fn (intern val)))))
  95.   
  96.   (let ((symname (symbol-name function))
  97.     (retval nil))
  98.     (or doc-host
  99.     (setq doc-host (rpc-hm-get-current-host)))
  100.     (prog1
  101.     (setq 
  102.      retval
  103.      (rpc-hm-internal
  104.       doc-host
  105.       (concat
  106.        "(format nil \"Function ~A:~A ~:A~\%~\%~8T~A\" "
  107.        ;; ~% has to be \-ed, to avoid elisp interference.
  108.        "(package-name (symbol-package '" symname "))"
  109.        "(symbol-name '" symname ")"
  110.        "(if (fboundp '" symname ")" "(arglist '" symname ")"
  111.        "\"[Not a Function]\")"
  112.        "(or (documentation '" symname " 'function)"
  113.        "\"[Not documented]\" ))"
  114.        ) 'invoke-reader ':any))
  115.       (and (not noninteractive) (not no-display)
  116.        (save-excursion
  117.          (set-buffer (get-buffer-create "*Documentation Output*"))
  118.          (goto-char (point-min))
  119.          (insert retval
  120.              (format
  121.               "\n\n%s%s%s%s.\n\n\n"
  122.               ";;; End of documentation for "
  123.               (upcase symname)
  124.               " provided by "
  125.               (upcase
  126.                (if (stringp doc-host) doc-host
  127.              (prin1-to-string doc-host)))))
  128.          (goto-char (point-min))
  129.          (display-buffer "*Documentation Output*")
  130.          (rld-print-help-return-message))))))
  131.  
  132.   
  133. (defun rld-describe-variable (var &optional doc-host no-display)
  134.   "Display the documentation of VAR [supplied by DOC-HOST].
  135. If optional third arg NO-DISPLAY is non-nil, the doc is not displayed in
  136. a separate buffer."
  137.  
  138.   (interactive 
  139.    (let ((v (rld-variable-at-point))
  140.      (enable-recursive-minibuffers t)
  141.      val)
  142.      (setq
  143.       val
  144.       (completing-read
  145.        (if v (format "Describe variable (default %s): " v)
  146.      "Describe variable: ")
  147.        obarray 'boundp nil))
  148.      (list (if (equal val "") v (intern val)))))
  149.   
  150.   (let ((symname (symbol-name var))
  151.     (retval nil))
  152.     (or doc-host
  153.     (setq doc-host (rpc-hm-get-current-host)))
  154.     (prog1
  155.     (setq 
  156.      retval
  157.      (rpc-hm-internal
  158.       doc-host
  159.       (concat
  160.        "(format nil \"Variable ~A:~A [~A]~\%~\%~8T~A\" "
  161.        "(package-name (symbol-package '" symname "))"
  162.        "(symbol-name '" symname ")"
  163.        "(if (boundp '" symname ") 'bound 'unbound)"
  164.        "(or (documentation '" symname " 'variable)"
  165.        "\"[Not documented]\" ))"
  166.        ) 'invoke-reader ':any))
  167.       (and (not noninteractive) (not no-display)
  168.        (save-excursion
  169.          (set-buffer (get-buffer-create "*Documentation Output*"))
  170.          (goto-char (point-min))
  171.          (insert retval
  172.              (format
  173.               "\n\n%s%s%s%s.\n\n\n"
  174.               ";;; End of documentation for "
  175.               (upcase symname)
  176.               " provided by "
  177.               (upcase
  178.                (if (stringp doc-host) doc-host
  179.              (prin1-to-string doc-host)))))
  180.          (goto-char (point-min))
  181.          (display-buffer "*Documentation Output*")
  182.          (rld-print-help-return-message))))))
  183.