bug#8951: 24.0.50; [PATCH] enhancement request: buttonize key names

["Drew Adams" <drew.adams@oracle.com>]

[-- Attachment #1: Type: text/plain, Size: 4363 bytes --]

Sent to emacs-devel@gnu.org 2011/06/27:
http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg01081.html
 
Submitting as enhancement request.  Patch attached.
 
Here is another patch for Emacs help functions.  It handles
`describe-mode', `describe-function', and `describe-variable',
and the same feature it provides can be applied to other help
commands where appropriate.
 
What is the feature?  Let users click a key description (i.e., a
key name, such as `C-f') in a buffer such as *Help* to see the
associated help.  This applies to key descriptions derived from
\[...] doc patterns (only).
 
`substitute-command-keys' converts a doc string that uses
patterns such as `\[COMMAND]' to COMMAND's key description.
For example, it might convert `\[mouse-yank-secondary]' to
`<M-mouse-2>'.  It interprets COMMAND's bindings relative to a
given KEYMAP if that `\[...]' pattern is preceded by a
`\<KEYMAP>' pattern.
 
Once this conversion is done, however, the COMMAND and its KEYMAP
are lost, missing from the resulting doc string.  More
importantly, this information is lost to the code that uses the
conversion result - the code for `describe-variable' etc.
 
(Yes, the original string might be available to the calling code,
but that code would need to parse it to figure out the
correspondence between COMMAND and resulting key description.
IOW, it would need to do much of what `substitute-command-keys'
already does.)
 
The user sees only the description `<M-mouse-2>' in buffer *Help*
where the substituted doc string is used.  What if s?he wants to
know more about what that key does in the documented context?
S?he can hit `C-h k' and then try the key, but that will work
only if the current mode has the same binding (e.g., with KEYMAP
active for COMMAND).
 
The aim of the feature provided by the attached patch is to
replace such simple key descriptions, which were derived from
rich info (COMMAND and KEYMAP) about a documented context, with
help buttons that use that info to link to descriptions of the
commands associated with the keys.
 
The feature has the effect of giving `substitute-command-keys' an
optional arg that, when non-nil, makes that function not only
substitute the key description for the command but also buttonize
the key-description part of the result string.
 
The effect is that if the result string is inserted in a buffer
(e.g. *Help*) then the user can click or hit `RET' on the key
description (e.g. `<M-mouse-2>') to get help on the associated
command (e.g. `mouse-yank-secondary').
 
Actually, I did not patch the `substitute-command-keys' C code to
give it an extra arg for this.  Instead, I wrote a Lisp version:
`help-substitute-command-keys'.  (For the part that handles
\{...}, this function just calls `substitute-command-keys'.)  If
someone wants to patch the C code instead, go for it.
 
Similarly, I wrote Lisp wrappers for `documentation' and
`documentation-property' that accept the same optional arg and
pass it to `help-substitute-command-keys'.
 
Then, in the body of commands `describe-variable' etc., I changed
`(documentation X)' to `(help-documentation nil t)' to get the
buttonized help string.
 
Give it a try.  If you decide to go for the idea then you might
prefer to just add the optional arg to `substitute-command-keys'
rather than creating a separate function.  (I didn't have that
choice as a Lisp user.)
 
However, even in that case you might decide to opt for a Lisp
version (why not?) - IOW, move `substitute-command-keys' to Lisp.
 
You can do that by renaming `substitute-command-keys' to
<something>, removing most of the <something> code, and renaming
`help-substitute-command-keys' to `substitute-command-keys'.  A
small amount of the <something> C code is still needed to handle
the \{..} case (no buttons).
 
If you want to try it without applying the patches, you can just
download this library and load it:
http://www.emacswiki.org/emacs/download/help-fns%2b.el.  (In that
case you will also see the automatic Info links discussed in
thread "adding manual cross-ref links to *Help*":
http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00368.html)
 
In GNU Emacs 24.0.50.1 (i386-mingw-nt5.1.2600)
 of 2011-06-27 on 3249CTO
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (4.5) --no-opt --cflags
-Ic:/build/include'
 

[-- Attachment #2: help-2011-06-27.patch --]
[-- Type: application/octet-stream, Size: 9109 bytes --]

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)
  
  \f
+ (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))
+ \f
  
  (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

[-- Attachment #3: help-fns-2011-06-27.patch --]
[-- Type: application/octet-stream, Size: 2621 bytes --]

diff -c -w help-fns.el help-fns-patched-2011-06-27.el
*** help-fns.el	Mon Jun 27 09:08:20 2011
--- help-fns-patched-2011-06-27.el	Mon Jun 27 09:51:14 2011
***************
*** 527,533 ****
        (let* ((advertised (gethash def advertised-signature-table t))
  	     (arglist (if (listp advertised)
  			  advertised (help-function-arglist def)))
! 	     (doc (condition-case err (documentation function)
                      (error (format "No Doc! %S" err))))
  	     (usage (help-split-fundoc doc function)))
  	(with-current-buffer standard-output
--- 527,533 ----
        (let* ((advertised (gethash def advertised-signature-table t))
  	     (arglist (if (listp advertised)
  			  advertised (help-function-arglist def)))
! 	     (doc (condition-case err (help-documentation function nil t)
                      (error (format "No Doc! %S" err))))
  	     (usage (help-split-fundoc doc function)))
  	(with-current-buffer standard-output
***************
*** 545,551 ****
  			    (while (and (symbolp fun)
  					(setq fun (symbol-function fun))
  					(not (setq usage (help-split-fundoc
! 							  (documentation fun)
  							  function)))))
  			    usage)
  			  (car usage))
--- 545,551 ----
  			    (while (and (symbolp fun)
  					(setq fun (symbol-function fun))
  					(not (setq usage (help-split-fundoc
! 							  (help-documentation fun nil t)
  							  function)))))
  			    usage)
  			  (car usage))
***************
*** 786,793 ****
                     (obsolete (get variable 'byte-obsolete-variable))
  		   (use (car obsolete))
  		   (safe-var (get variable 'safe-local-variable))
!                    (doc (or (documentation-property variable 'variable-documentation)
!                             (documentation-property alias 'variable-documentation)))
                     (extra-line nil))
                ;; Add a note for variables that have been make-var-buffer-local.
                (when (and (local-variable-if-set-p variable)
--- 786,793 ----
                     (obsolete (get variable 'byte-obsolete-variable))
  		   (use (car obsolete))
  		   (safe-var (get variable 'safe-local-variable))
!                    (doc (or (help-documentation-property variable 'variable-documentation nil t)
!                             (help-documentation-property alias 'variable-documentation nil t)))
                     (extra-line nil))
                ;; Add a note for variables that have been make-var-buffer-local.
                (when (and (local-variable-if-set-p variable)

Diff finished.  Mon Jun 27 09:52:12 2011