;; ********************************************************************** ;;
;;
;;  File	: hyper-apropos.el (was emacs-apropos.el)
;;  Author	: Frank C. Guida <fcg@philabs.philips.com>
;;		: and Stig <stig@lucid.com>
;;  Created	: Fri Jun  4 10:33:53 1993
;;
;;  Description : Variation on command-apropos.
;;
;;  Rather than run apropos and print all the documentation at once,
;;  I find it easier to view a "table of contents" first, then
;;  get the details for symbols as you need them.
;;
;;  This version of apropos prints two lists of symbols matching the
;;  given regexp:  functions/macros and variables/constants.
;;
;;  The user can then do the following:
;;
;;      - add an additional regexp to narrow the search
;;      - display documentation for the current symbol
;;      - find the tag for the current symbol
;;      - show any keybindings if the current symbol is a command
;;	- invoke functions
;;	- set variables
;;
;;  An additional feature is the ability to search the current tags
;;  table, allowing you to interrogate functions not yet loaded (this
;;  isn't available with the standard package).
;;
;;  Mouse bindings and menus are provided for XEmacs.
;;
;; ********************************************************************** ;;

(require 'tags "etags")

(defvar ea-prev-wconfig nil
  "Window configuration when hyper-apropos was called.")

;; ---------------------------------------------------------------------- ;;

;;;###autoload
(defun hyper-apropos (regexp use-tags)
  "Display lists of functions and variables matching REGEXP
in buffer *Hyper Apropos*.  If optional prefix arg is given, search
the current tags table for symbols.  See also hyper-apropos-mode."
  (interactive "sList symbols matching regexp: \nP")
  (setq hypropos-prev-wconfig (current-window-configuration))
  (let ((flist '())			;; functions
	(vlist '())			;; variables
	beg)
    (if use-tags
	(progn 
	  (visit-tags-table-buffer)
	  (setq case-fold-search nil)
	  (goto-char 1)
	  (while (re-search-forward regexp nil t)
	    (beginning-of-line)
	    (cond ((looking-at "^DEFUN")
		   (search-forward "\"")
		   (setq beg (point))
		   (forward-sexp 1)
		   (setq flist
			 (cons (buffer-substring beg (point)) flist)))

		  ((looking-at "^\(defmacro\\|^\(defun")
		   (re-search-forward "[ \t]+")
		   (setq beg (point))
		   (while (not (looking-at "[ \t\177\(]"))
		     (forward-char 1))
		   (setq flist
			 (cons (buffer-substring beg (point)) flist)))

		  ((looking-at "^\(defvar\\|^\(defconst")
		   (re-search-forward "[ \t]+")
		   (setq beg (point))
		   (while (not (looking-at "[ \t\177\(]"))
		     (forward-char 1))
		   (setq vlist
			 (cons (buffer-substring beg (point)) vlist))))
	    (forward-line 1)))
      (setq flist (apropos-internal regexp 'fboundp)
	    vlist (apropos-internal regexp 'boundp)))
    (set-buffer (get-buffer-create "*Hyper Apropos*"))
    (erase-buffer)
    (insert "Functions and Macros:\n\n"
	    (mapconcat 'prin1-to-string flist "\n")
	    "\nVariables and Constants:\n\n"
	    (mapconcat 'prin1-to-string vlist "\n"))
    ;; 
    (switch-to-buffer "*Hyper Apropos*")
    (hyper-apropos-mode regexp)))


;; ---------------------------------------------------------------------- ;;

;;;###autoload
(defun hyper-apropos-mode (regexp)
  "Improved apropos mode for displaying Emacs documentation.  Function and
variable names are displayed in the buffer \"*Hyper Apropos*\".

General Commands:

	SPC	- scroll window forward
	  b	- scroll window backward
	  n     - narrow the search using another pattern
		  (delete all lines not containing new pattern)
	  /	- isearch-forward
	  q	- restore previous window config and exit

Operations for Symbol on Current Line:

    	RET 	- display the symbol's documentation
		  (also on button2 in xemacs)
	  w     - show the keybinding if symbol is a command
	  i	- invoke function on current line
	  s	- set value of variable on current line
	  t	- display the C or lisp source (find-tag)"
  (delete-other-windows)
  (setq mode-name "Hyper-Apropos"
	major-mode 'hyper-apropos-mode
	mode-line-buffer-identification
	(concat "Hyper Apropos: " "\"" regexp "\""))
  ;;
  (setq hypropos-keymap (make-sparse-keymap))
  (suppress-keymap hypropos-keymap)
  (define-key hypropos-keymap "\C-m"  'hypropos-get-doc)
  (define-key hypropos-keymap " "     'scroll-up)
  (define-key hypropos-keymap "b"     'scroll-down)
  (define-key hypropos-keymap "n"     'hypropos-add-keyword)
  (define-key hypropos-keymap "w"     'hypropos-where-is)
  (define-key hypropos-keymap "i"     'hypropos-invoke-fn)
  (define-key hypropos-keymap "s"     'hypropos-set-variable)
  (define-key hypropos-keymap "t"     'hypropos-find-tag)
  (define-key hypropos-keymap "/"     'isearch-forward)
  (define-key hypropos-keymap "q"     'hypropos-quit)
  ;;
  ;; XEmacs mouse support
  ;;
  (if (string-match "XEmacs" emacs-version)
      (progn
	(define-key hypropos-keymap 'button2   'hypropos-mouse-get-doc)
	(define-key hypropos-keymap 'button3   'hypropos-popup-menu)
	(setq mode-motion-hook 'mode-motion-highlight-line)
	))
  (use-local-map hypropos-keymap)
  (goto-char 1))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-get-doc (&optional symbol)
  "Display documentation for symbol on current line in buffer *Help*."
  (interactive)
  (if (null symbol)
      (setq symbol
	    (save-excursion
	      (beginning-of-line)
	      (read (buffer-substring
		     (point) (progn (end-of-line) (point)))))))
  (with-output-to-temp-buffer "*Help*"
    (princ (format "%s" symbol))
    (if (or (fboundp symbol) (boundp symbol))
	(let (beg)
	  (set-buffer (get-buffer "*Help*"))
	  (if (fboundp symbol)
	      (progn 
		(princ "\n\nFunction")
		(princ (if (commandp symbol) ", Command:\n\n" ":\n\n"))
		(setq beg (point))
		(princ (or (documentation symbol)
			   "function not documented"))
		(indent-rigidly beg (point) 2)
		))
	  (if (boundp symbol)
	      (progn 
		(princ "\n\nVariable:\n\n")
		(setq beg (point))
		(princ (format "value = %s\n\n%s"
			       (symbol-value symbol)
			       (or (documentation-property
				    symbol 'variable-documentation)
				   "variable not documented")))
		(indent-rigidly beg (point) 2)
		)))
      (princ "\n\nsymbol is not currently bound"))))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-mouse-get-doc (event)
  "Get the documentation for the symbol the mouse is on."
  (interactive "e")
  (mouse-set-point event)
  (save-excursion
    (let* ((buffer (window-buffer (event-window event)))
	   (p (event-point event))
	   (extent (and p (extent-at p buffer 'highlight)))
	   (text (and extent
		      (save-excursion
			(set-buffer buffer)
			(buffer-substring
			 (extent-start-position extent)
			 (extent-end-position extent))))))
      (if (null extent) nil
	(hypropos-get-doc (read text))))))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-add-keyword (regexp)
  "Use additional keyword to narrow regexp match."
  (interactive "sAdditional Keyword: ")
  (save-excursion
    (goto-char (point-min))
    (keep-lines (concat regexp "\\|^Functions and Macros:$\n\\|\nVariables and Constants:$\n"))))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-this-symbol ()
  (read (save-excursion (beginning-of-line) (point-marker))))

(defun hypropos-where-is (symbol)
  "Find keybinding for symbol on current line."
  (interactive (list (hypropos-this-symbol)))
  (where-is symbol))

(defun hypropos-invoke-fn (fn)
  "Interactively invoke the function on the current line."
  (interactive (list (hypropos-this-symbol)))
  (cond ((not (fboundp fn))
	 (error "%S is not a function" fn))
	(t (call-interactively fn))))

(defun hypropos-set-variable (var val)
  "Interactively set the variable on the current line."
  (interactive
   (let ((var (hypropos-this-symbol)))
     (or (boundp var) (error "%S is not a variable" var))
     (hypropos-get-doc var)
     (list var
	   (let ((prop (get var 'variable-interactive)))
	     (if prop
		 (call-interactively (list 'lambda '(arg)
					   (list 'interactive prop)
					   'arg))
	       (eval-minibuffer
		(format (gettext "Set %s to value: ") var)
		(prin1-to-string (symbol-value var))))))
     ))
  (set var val))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-find-tag (&optional tag-name)
  "Find the tag for the symbol on the current line in other window."
  (interactive)
  ;; there ought to be a default tags file for this...
  (or tag-name
      (setq tag-name
	    (save-excursion
	      (beginning-of-line)
	      (buffer-substring (point) (progn (end-of-line) (point))))))
  (find-tag-other-window tag-name))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-quit ()
  (interactive)
  "Quit Hyper Apropos and restore original window config."
  (bury-buffer "*Hyper Apropos*")
  (set-window-configuration hypropos-prev-wconfig))

;; ---------------------------------------------------------------------- ;;

(defun hypropos-popup-menu (event)
  (interactive "e")
  (mouse-set-point event)
  (beginning-of-line)
  (let* ((sym (hypropos-this-symbol))
	 (hypropos-function-p (fboundp sym))
	 (hypropos-variable-p (boundp sym))
	 (hypropos-menu
	  '("Apropos Commands"
	    ["Help"                  describe-mode         t]
	    ["Display Documentation" hypropos-get-doc	   t]
	    ["Where is Command?"     hypropos-where-is	   hypropos-function-p]
	    ["Invoke Command"	     hypropos-invoke-fn	   hypropos-function-p]
	    ["Set Variable"	     hypropos-set-variable hypropos-variable-p]
	    ["Find Tag for Symbol"   hypropos-find-tag	   t]
	    ["Add Keyword..."	     hypropos-add-keyword  t]
	    ["Quit"		     hypropos-quit	   t]
	    )))
    (popup-menu hypropos-menu)))

(provide 'hyper-apropos)

;;
;; end of hyper-apropos.el
;;
