--- a/lisp/help.el	Mon Aug 13 11:33:40 2007 +0200
+++ b/lisp/help.el	Mon Aug 13 11:35:02 2007 +0200
@@ -240,10 +240,8 @@
 otherwise it is killed."
   (interactive)
   (let ((buf (current-buffer)))
-    (cond ((frame-property (selected-frame) 'help-window-config)
-	   (set-window-configuration
-	    (frame-property (selected-frame) 'help-window-config))
-	   (set-frame-property  (selected-frame) 'help-window-config nil))
+    (cond (help-window-config
+	   (set-window-configuration help-window-config))
 	  ((not (one-window-p))
 	   (delete-window)))
     (if bury
@@ -480,6 +478,21 @@
 ;; another name (which is a shame, because w-d-h-b is a perfect name
 ;; for a macro) that uses with-displaying-help-buffer internally.
 
+(defcustom mode-for-help 'help-mode
+  "*Mode that help buffers are put into.")
+
+(defvar help-sticky-window nil
+;; Window into which help buffers will be displayed, rather than
+;; always searching for a new one.  This is INTERNAL and liable to
+;; change its interface and/or name at any moment.  It should be
+;; bound, not set.
+)
+
+(defvar help-window-config nil)
+
+(make-variable-buffer-local 'help-window-config)
+(put 'help-window-config 'permanent-local t)
+
 (defun with-displaying-help-buffer (thunk &optional name)
   "Form which makes a help buffer with given NAME and evaluates BODY there.
 The actual name of the buffer is generated by the function `help-buffer-name'."
@@ -492,19 +505,28 @@
 			  (mapcar 'window-frame
 				  (windows-of-buffer buffer-name)))))))
     (help-register-and-maybe-prune-excess buffer-name)
-    (prog1 (with-output-to-temp-buffer buffer-name
-	     (prog1 (funcall thunk)
-	       (save-excursion
-		 (set-buffer standard-output)
-		 (help-mode))))
+    ;; if help-sticky-window is bogus or deleted, get rid of it.
+    (if (and help-sticky-window (or (not (windowp help-sticky-window))
+				    (not (window-live-p help-sticky-window))))
+	(setq help-sticky-window nil))
+    (prog1
+	(let ((temp-buffer-show-function
+	       (if help-sticky-window
+		   #'(lambda (buffer)
+		       (set-window-buffer help-sticky-window buffer))
+		 temp-buffer-show-function)))
+	  (with-output-to-temp-buffer buffer-name
+	    (prog1 (funcall thunk)
+	      (save-excursion
+		(set-buffer standard-output)
+		(funcall mode-for-help)))))
       (let ((helpwin (get-buffer-window buffer-name)))
 	(when helpwin
-	  (with-current-buffer (window-buffer helpwin)
-	    ;; If the *Help* buffer is already displayed on this
-	    ;; frame, don't override the previous configuration
-	    (when help-not-visible
-	      (set-frame-property (selected-frame)
-				  'help-window-config winconfig)))
+	  ;; If the *Help* buffer is already displayed on this
+	  ;; frame, don't override the previous configuration
+	  (when help-not-visible
+	    (with-current-buffer (window-buffer helpwin)
+	      (setq help-window-config winconfig)))
 	  (when help-selects-help-window
 	    (select-window helpwin))
 	  (cond ((eq helpwin (selected-window))
@@ -730,7 +752,10 @@
 	   (stringp Installation-string))
       (with-displaying-help-buffer
        (lambda ()
-	 (princ Installation-string))
+	 (princ
+	  (if (fboundp 'decode-coding-string)
+	      (decode-coding-string Installation-string 'automatic-conversion)
+	    Installation-string)))
        "Installation")
     (error "No Installation information available.")))
 
@@ -742,16 +767,15 @@
 (defun xemacs-www-page ()
   "Go to the XEmacs World Wide Web page."
   (interactive)
-  (if (boundp 'browse-url-browser-function)
-      (funcall browse-url-browser-function "http://www.xemacs.org/")
+  (if (fboundp 'browse-url)
+      (browse-url "http://www.xemacs.org/")
     (error "xemacs-www-page requires browse-url")))
 
 (defun xemacs-www-faq ()
   "View the latest and greatest XEmacs FAQ using the World Wide Web."
   (interactive)
-  (if (boundp 'browse-url-browser-function)
-      (funcall browse-url-browser-function
-	       "http://www.xemacs.org/faq/index.html")
+  (if (fboundp 'browse-url)
+      (browse-url "http://www.xemacs.org/faq/index.html")
     (error "xemacs-www-faq requires browse-url")))
 
 (defun xemacs-local-faq ()
@@ -919,6 +943,21 @@
 	      (setq obj (read (current-buffer)))
 	      (and (symbolp obj) (fboundp obj) obj)))))))
 
+(defun function-at-event (event)
+  "Return the function whose name is around the position of EVENT.
+EVENT should be a mouse event.  When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately.  This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no function around that point, nil is returned."
+  (if (and event (event-buffer event) (event-point event))
+      (save-excursion
+	(set-buffer (event-buffer event))
+	(goto-char (event-point event))
+	(function-at-point))))
+
 ;; Default to nil for the non-hackers?  Not until we find a way to
 ;; distinguish hackers from non-hackers automatically!
 (defcustom describe-function-show-arglist t
@@ -1062,6 +1101,119 @@
 	     (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
 	(setq doc (substring doc 0 (match-beginning 0))))
     doc))
+;  (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
+;    (list
+;     ;;
+;     ;; The symbol itself.
+;     (list (concat "\\`\\(" name-char "+\\)\\(:\\)?")
+;	   '(1 (if (match-beginning 2)
+;		   'font-lock-function-name-face
+;		 'font-lock-variable-name-face)
+;	       nil t))
+;     ;;
+;     ;; Words inside `' which tend to be symbol names.
+;     (list (concat "`\\(" sym-char sym-char "+\\)'")
+;	   1 '(prog1
+;		  'font-lock-reference-face
+;		(add-list-mode-item (match-beginning 1)
+;			       (match-end 1)
+;			       nil
+;			       'help-follow-reference))
+;	   t)
+;     ;;
+;     ;; CLisp `:' keywords as references.
+;     (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))
+
+(defvar help-symbol-regexp
+  (let ((sym-char "[+a-zA-Z0-9_:*]")
+	(sym-char-no-dash "[-+a-zA-Z0-9_:*]"))
+    (concat "\\("
+	    ;; a symbol with a - in it.
+	    "\\<\\(" sym-char-no-dash "+\\(-" sym-char-no-dash "+\\)+\\)\\>"
+	    "\\|"
+	    "`\\(" sym-char "+\\)'"
+	    "\\)")))
+
+(defun help-symbol-run-function-1 (ev ex fun)
+  (let ((help-sticky-window
+	 ;; if we were called from a help buffer, make sure the new help
+	 ;; goes in the same window.
+	 (if (and (event-buffer ev)
+		  (symbol-value-in-buffer 'help-window-config
+					  (event-buffer ev)))
+	     (event-window ev)
+	   help-sticky-window)))
+    (funcall fun (extent-property ex 'help-symbol))))
+
+(defun help-symbol-run-function (fun)
+  (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
+    (when ex
+      (help-symbol-run-function-1 last-popup-menu-event ex fun))))
+
+(defvar help-symbol-function-context-menu
+  '("---"
+    ["View %_Documentation" (help-symbol-run-function 'describe-function)]
+    ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+    ))
+
+(defvar help-symbol-variable-context-menu
+  '("---"
+    ["View %_Documentation" (help-symbol-run-function 'describe-variable)]
+    ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+    ))
+
+(defvar help-symbol-function-and-variable-context-menu
+  '("---"
+    ["View Function %_Documentation" (help-symbol-run-function 
+				      'describe-function)]
+    ["View Variable D%_ocumentation" (help-symbol-run-function
+				      'describe-variable)]
+    ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+    ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+    ))
+
+(defun frob-help-extents (buffer)
+  ;; Look through BUFFER, starting at the buffer's point and continuing
+  ;; till end of file, and find documented functions and variables.
+  ;; any such symbol found is tagged with an extent, that sets up these
+  ;; properties:
+  ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over)
+  ;; 2. help-symbol is the name of the symbol.
+  ;; 3. context-menu is a list of context menu items, specific to whether
+  ;;    the symbol is a function, variable, or both.
+  ;; 4. activate-function will cause the function or variable to be described,
+  ;;    replacing the existing help contents.
+  (save-excursion
+    (set-buffer buffer)
+    (let (b e name)
+      (while (re-search-forward help-symbol-regexp nil t)
+	(setq b (or (match-beginning 2) (match-beginning 4)))
+	(setq e (or (match-end 2) (match-end 4)))
+	(setq name (buffer-substring b e))
+	(let* ((sym (intern-soft name))
+	       (var (and sym (boundp sym)
+			 (documentation-property sym
+						 'variable-documentation t)))
+	       (fun (and sym (fboundp sym)
+			 (documentation sym t))))
+	  (when (or var fun)
+	    (let ((ex (make-extent b e)))
+	      (set-extent-property ex 'mouse-face 'highlight)
+	      (set-extent-property ex 'help-symbol sym)
+	      (set-extent-property
+	       ex 'context-menu
+	       (cond ((and var fun)
+		      help-symbol-function-and-variable-context-menu)
+		     (var help-symbol-variable-context-menu)
+		     (fun help-symbol-function-context-menu)))
+	      (set-extent-property
+	       ex 'activate-function
+	       (if fun
+		   #'(lambda (ev ex)
+		       (help-symbol-run-function-1 ev ex 'describe-function))
+		 #'(lambda (ev ex)
+		     (help-symbol-run-function-1 ev ex 'describe-variable))))
+	      ))))))) ;; 11 parentheses!
 
 (defun describe-function-1 (function &optional nodoc)
   "This function does the work for `describe-function'."
@@ -1158,7 +1310,13 @@
 	     (unless (and obsolete aliases)
 	       (let ((doc (function-documentation function t)))
 		 (princ "Documentation:\n")
-		 (princ doc)
+		 (let ((oldp (point standard-output))
+		       newp)
+		   (princ doc)
+		   (setq newp (point standard-output))
+		   (goto-char oldp standard-output)
+		   (frob-help-extents standard-output)
+		   (goto-char newp standard-output))
 		 (unless (or (equal doc "")
 			     (eq ?\n (aref doc (1- (length doc)))))
 		   (terpri)))))))))
@@ -1172,7 +1330,6 @@
   (message nil)
   (message (function-arglist function)))
 
-
 (defun variable-at-point ()
   (ignore-errors
     (with-syntax-table emacs-lisp-mode-syntax-table
@@ -1185,6 +1342,21 @@
 	(let ((obj (read (current-buffer))))
 	  (and (symbolp obj) (boundp obj) obj))))))
 
+(defun variable-at-event (event)
+  "Return the variable whose name is around the position of EVENT.
+EVENT should be a mouse event.  When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately.  This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no variable around that point, nil is returned."
+  (if (and event (event-buffer event) (event-point event))
+      (save-excursion
+	(set-buffer (event-buffer event))
+	(goto-char (event-point event))
+	(variable-at-point))))
+
 (defun variable-obsolete-p (variable)
   "Return non-nil if VARIABLE is obsolete."
   (not (null (get variable 'byte-obsolete-variable))))
@@ -1313,7 +1485,13 @@
 	 (when (or (not obsolete) (not aliases))
 	   (if doc
 	       ;; note: documentation-property calls substitute-command-keys.
-	       (princ doc)
+	       (let ((oldp (point standard-output))
+		     newp)
+		 (princ doc)
+		 (setq newp (point standard-output))
+		 (goto-char oldp standard-output)
+		 (frob-help-extents standard-output)
+		 (goto-char newp standard-output))
 	     (princ "not documented as a variable."))))
        (terpri)))
    (format "variable `%s'" variable)))
@@ -1446,5 +1624,4 @@
 	(with-displaying-help-buffer
 	 (insert string)))))
 
-
 ;;; help.el ends here