diff -c -w help.el help-patched-2011-06-27.el
*** help.el	Mon Jun 27 09:07:04 2011
--- help-patched-2011-06-27.el	Mon Jun 27 09:36:14 2011
***************
*** 251,256 ****
--- 251,390 ----
    help-map)
  
  
+ (defun help-documentation (function &optional raw add-help-buttons)
+   "Same as `documentation', but optionally adds buttons for help.
+ Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
+ descriptions, which link to the key's command help."
+   (let ((raw-doc  (documentation function 'RAW)))
+     (if raw  raw-doc  (help-substitute-command-keys raw-doc add-help-buttons))))
+     
+ (defun help-documentation-property (symbol prop &optional raw add-help-buttons)
+   "Same as `documentation-property', but optionally adds buttons for help.
+ Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
+ descriptions, which link to the key's command help."
+   (let ((raw-doc  (documentation-property symbol prop 'RAW)))
+     (if raw  raw-doc  (help-substitute-command-keys raw-doc add-help-buttons))))
+ 
+ (defun help-commands-to-key-buttons (string)
+   "Like `substitute-command-keys', but adds buttons for help on keys.
+   Key descriptions become links to help about their commands."
+   (help-substitute-command-keys string 'ADD-HELP-BUTTONS))
+ 
+ (defun help-substitute-command-keys (string &optional add-help-buttons)
+   "Same as `substitute-command-keys', but optionally adds buttons for help.
+ Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
+ descriptions, which link to the key's command help."
+ 
+   ;; REPEAT:
+   ;;  Search for first occurrence of any of the patterns: \[...], \{...}, or \<...>.
+   ;;  Handle escaping via \=, if present before the pattern.
+   ;;  If pattern is a keymap (\<...>): use it from then on.
+   ;;  If pattern is a command (\[...]): (a) substitute its key description, (b) put a button on it.
+   ;;  If pattern is a bindings spec (\{...}): just substitute the usual text.
+   (with-syntax-table emacs-lisp-mode-syntax-table
+     (let* ((strg          (copy-sequence string))
+            (len-strg      (length strg))
+            (ii            0)
+            (jj            0)
+            (newstrg       "")
+            (re-command    "\\\\\\[\\(\\(\\sw\\|\\s_\\)+\\)\\]")
+            (re-keymap     "\\\\<\\(\\(\\sw\\|\\s_\\)+\\)>")
+            (re-bindings   "\\\\{\\(\\(\\sw\\|\\s_\\)+\\)}")
+            (re-any        (concat "\\(" re-command  "\\|" re-keymap "\\|" re-bindings "\\)"))
+            (keymap        (or overriding-terminal-local-map overriding-local-map))
+            (msg           nil)
+            key bindings ma mc mk mb)
+       (while (< ii len-strg)
+         (setq key       nil
+               bindings  nil
+               strg      (substring strg ii))
+         (save-match-data                ; ANY
+           (setq ma  (string-match re-any strg))
+           (if (not ma)
+               (setq newstrg  (concat newstrg strg)
+                     ii       len-strg
+                     jj       len-strg)
+             (let ((escaped  nil)
+                   (odd      nil))
+               (save-match-data
+                 (let ((ma1  ma))
+                   (setq ii  ma)
+                   (while (string-match "\\\\=$" (substring strg 0 ma1))
+                     (setq odd  (not odd)
+                           ma1  (match-beginning 0))
+                     (when odd
+                       (setq ii       (- ii 2)
+                             escaped  ma1)))))
+               (if (not escaped)
+                   (setq ii       ma
+                         jj       (match-end 0)
+                         ma       (match-string-no-properties 0 strg)
+                         newstrg  (concat newstrg (substring strg 0 ii)))
+                 (setq jj       (match-end 0) ; End of \[...], \{...}, or \<...>
+                       newstrg  (if odd
+                                    (concat newstrg
+                                            (substring strg 0 ii) ; Unescaped \='s
+                                            (substring strg ma jj)) ; \[...], \{...}, or \<...>
+                                  (concat newstrg (substring strg 0 ii)))
+                       ma       (if odd nil (match-string-no-properties 0 strg))
+                       ii       jj)))))
+         (when ma
+           (save-match-data              ; KEYMAP
+             (setq ma  (copy-sequence ma))
+             (setq mk  (string-match re-keymap ma))
+             (setq mk  (and mk (match-string-no-properties 0 ma)))
+             (when mk
+               (setq keymap  (intern (match-string-no-properties 1 ma)))
+               (if (boundp keymap)
+                   (setq keymap  (symbol-value keymap))
+                 (setq msg  (format "\nUses keymap \"%s\", which is not currently defined.\n"
+                                    keymap))
+                 (setq keymap  (or overriding-terminal-local-map overriding-local-map)))))
+           (unless mk                    ; COMMAND
+             (save-match-data
+               (setq ma  (copy-sequence ma))
+               (setq mc  (string-match re-command ma))
+               (setq mc  (and mc (match-string-no-properties 0 ma)))
+               (setq mc  (and mc (intern (substring mc 2 -1)))) ; Remove \[...] envelope
+               (when mc
+                 (let ((follow-remap  t))
+                   (while (and (setq key  (where-is-internal mc keymap 'FIRSTONLY))
+                               (vectorp key) (> (length key) 1) (eq 'remap (aref key 0))
+                               (symbolp (aref key 1)) follow-remap)
+                     (setq mc            (aref key 1)
+                           follow-remap  nil)))
+                 (setq key  (if key (key-description key) (concat "M-x " (symbol-name mc))))
+                 (when add-help-buttons (setq key  (help-key-button-string key mc))))))
+           (unless (or mk mc)            ; BINDINGS
+             (save-match-data
+               (setq ma  (copy-sequence ma))
+               (setq mb  (string-match re-bindings ma))
+               (setq mb  (and mb (match-string-no-properties 0 ma)))
+               (when mb
+                 (setq bindings  (intern (match-string-no-properties 1 ma)))
+                 (cond ((boundp bindings)
+                        (setq bindings  (substitute-command-keys mb))) ; Use original - no buttons.
+                       (t
+                        (setq msg  (format "\nUses keymap \"%s\", which is not currently defined.\n"
+                                           bindings))
+                        (setq bindings  nil))))))
+           (unless mk
+             (setq newstrg  (concat newstrg (or key bindings (substring strg ii jj)))))
+           (setq ii  (or jj len-strg))))
+       (if (string= string newstrg)
+           string  ; Return original string, not a copy, if no changes.
+         newstrg))))
+ 
+ (defun help-key-button-string (key-description command)
+   "Return a button for KEY-DESCRIPTION that links to the COMMAND description.
+ KEY-DESCRIPTION is a key-description string.
+ COMMAND is the command (a symbol) associated with the key described.
+ Return a copy of string KEY-DESCRIPTION with button properties added.
+ Clicking the button shows the help for COMMAND."
+   (let ((new-key  (copy-sequence key-description)))
+     (make-text-button new-key nil 'button (list t) ':type 'help-function 'help-args (list command))
+     new-key))
+ 
  
  (defun function-called-at-point ()
    "Return a function around point or else called by the list containing point.
***************
*** 852,858 ****
  				     "no indicator"
  				   (format "indicator%s"
  					   indicator))))
! 		  (princ (documentation mode-function)))
  		(insert-button pretty-minor-mode
  			       'action (car help-button-cache)
  			       'follow-link t
--- 986,993 ----
  				     "no indicator"
  				   (format "indicator%s"
  					   indicator))))
!                   (with-current-buffer standard-output
!                     (insert (help-documentation mode-function nil 'ADD-HELP-BUTTONS))))
  		(insert-button pretty-minor-mode
  			       'action (car help-button-cache)
  			       'follow-link t
***************
*** 880,886 ****
  		(re-search-backward "`\\([^`']+\\)'" nil t)
  		(help-xref-button 1 'help-function-def mode file-name)))))
  	(princ ":\n")
! 	(princ (documentation major-mode)))))
    ;; For the sake of IELM and maybe others
    nil)
  
--- 1015,1022 ----
  		(re-search-backward "`\\([^`']+\\)'" nil t)
  		(help-xref-button 1 'help-function-def mode file-name)))))
  	(princ ":\n")
!         (with-current-buffer standard-output
!           (insert (help-documentation major-mode nil 'ADD-HELP-BUTTONS))))))
    ;; For the sake of IELM and maybe others
    nil)
  

Diff finished.  Mon Jun 27 09:53:41 2011
