From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: "Drew Adams" Newsgroups: gmane.emacs.bugs Subject: bug#8951: 24.0.50; [PATCH] enhancement request: buttonize key names Date: Tue, 28 Jun 2011 09:38:03 -0700 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0079_01CC3577.14941090" X-Trace: dough.gmane.org 1309279594 13544 80.91.229.12 (28 Jun 2011 16:46:34 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 28 Jun 2011 16:46:34 +0000 (UTC) To: 8951@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jun 28 18:46:29 2011 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QbbQj-00031E-AL for geb-bug-gnu-emacs@m.gmane.org; Tue, 28 Jun 2011 18:46:29 +0200 Original-Received: from localhost ([::1]:60776 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbQi-0000mm-6q for geb-bug-gnu-emacs@m.gmane.org; Tue, 28 Jun 2011 12:46:28 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:38035) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbJa-0007M6-Da for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:39:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QbbJX-0001Mk-7S for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:39:05 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:45919) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbJX-0001Me-13 for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:39:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1QbbJW-0006TU-7Q; Tue, 28 Jun 2011 12:39:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "Drew Adams" Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: owner@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 28 Jun 2011 16:39:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 8951 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: Original-Received: via spool by submit@debbugs.gnu.org id=B.130927911724856 (code B ref -1); Tue, 28 Jun 2011 16:39:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 28 Jun 2011 16:38:37 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1QbbJ5-0006Sr-NQ for submit@debbugs.gnu.org; Tue, 28 Jun 2011 12:38:36 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1QbbJ2-0006Sf-OA for submit@debbugs.gnu.org; Tue, 28 Jun 2011 12:38:33 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QbbIv-0001Hi-OP for submit@debbugs.gnu.org; Tue, 28 Jun 2011 12:38:27 -0400 Original-Received: from lists.gnu.org ([140.186.70.17]:37905) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbIv-0001Hc-EW for submit@debbugs.gnu.org; Tue, 28 Jun 2011 12:38:25 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:37841) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbIs-0007BX-UF for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:38:25 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QbbIq-0001HF-Sw for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:38:22 -0400 Original-Received: from rcsinet10.oracle.com ([148.87.113.121]:54638) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbbIq-0001H5-BA for bug-gnu-emacs@gnu.org; Tue, 28 Jun 2011 12:38:20 -0400 Original-Received: from acsinet21.oracle.com (acsinet21.oracle.com [141.146.126.237]) by rcsinet10.oracle.com (Switch-3.4.4/Switch-3.4.2) with ESMTP id p5SGcFAq010580 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK) for ; Tue, 28 Jun 2011 16:38:16 GMT Original-Received: from acsmt356.oracle.com (acsmt356.oracle.com [141.146.40.156]) by acsinet21.oracle.com (8.14.4+Sun/8.14.4) with ESMTP id p5SGcE1P027007 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO) for ; Tue, 28 Jun 2011 16:38:14 GMT Original-Received: from abhmt113.oracle.com (abhmt113.oracle.com [141.146.116.65]) by acsmt356.oracle.com (8.12.11.20060308/8.12.11) with ESMTP id p5SGc97v006554 for ; Tue, 28 Jun 2011 11:38:09 -0500 Original-Received: from dradamslap1 (/10.159.63.168) by default (Oracle Beehive Gateway v4.0) with ESMTP ; Tue, 28 Jun 2011 09:38:07 -0700 X-Mailer: Microsoft Office Outlook 11 X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.6109 Thread-Index: Acw1sb/LKPFqVG1xQ6SoDlFL64q7qw== X-Source-IP: acsinet21.oracle.com [141.146.126.237] X-Auth-Type: Internal IP X-CT-RefId: str=0001.0A090204.4E0A0379.0042:SCFMA922111,ss=1,re=-6.300,fgs=0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 1) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list Resent-Date: Tue, 28 Jun 2011 12:39:02 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:47556 Archived-At: This is a multi-part message in MIME format. ------=_NextPart_000_0079_01CC3577.14941090 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit 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 `'. It interprets COMMAND's bindings relative to a given KEYMAP if that `\[...]' pattern is preceded by a `\' 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 `' 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. `') 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 , removing most of the code, and renaming `help-substitute-command-keys' to `substitute-command-keys'. A small amount of the 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' ------=_NextPart_000_0079_01CC3577.14941090 Content-Type: application/octet-stream; name="help-2011-06-27.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="help-2011-06-27.patch" diff -c -w help.el help-patched-2011-06-27.el=0A= *** help.el Mon Jun 27 09:07:04 2011=0A= --- help-patched-2011-06-27.el Mon Jun 27 09:36:14 2011=0A= ***************=0A= *** 251,256 ****=0A= --- 251,390 ----=0A= help-map)=0A= =0A= =0C=0A= + (defun help-documentation (function &optional raw add-help-buttons)=0A= + "Same as `documentation', but optionally adds buttons for help.=0A= + Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key=0A= + descriptions, which link to the key's command help."=0A= + (let ((raw-doc (documentation function 'RAW)))=0A= + (if raw raw-doc (help-substitute-command-keys raw-doc = add-help-buttons))))=0A= + =0A= + (defun help-documentation-property (symbol prop &optional raw = add-help-buttons)=0A= + "Same as `documentation-property', but optionally adds buttons for = help.=0A= + Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key=0A= + descriptions, which link to the key's command help."=0A= + (let ((raw-doc (documentation-property symbol prop 'RAW)))=0A= + (if raw raw-doc (help-substitute-command-keys raw-doc = add-help-buttons))))=0A= + =0A= + (defun help-commands-to-key-buttons (string)=0A= + "Like `substitute-command-keys', but adds buttons for help on keys.=0A= + Key descriptions become links to help about their commands."=0A= + (help-substitute-command-keys string 'ADD-HELP-BUTTONS))=0A= + =0A= + (defun help-substitute-command-keys (string &optional add-help-buttons)=0A= + "Same as `substitute-command-keys', but optionally adds buttons for = help.=0A= + Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key=0A= + descriptions, which link to the key's command help."=0A= + =0A= + ;; REPEAT:=0A= + ;; Search for first occurrence of any of the patterns: \[...], = \{...}, or \<...>.=0A= + ;; Handle escaping via \=3D, if present before the pattern.=0A= + ;; If pattern is a keymap (\<...>): use it from then on.=0A= + ;; If pattern is a command (\[...]): (a) substitute its key = description, (b) put a button on it.=0A= + ;; If pattern is a bindings spec (\{...}): just substitute the = usual text.=0A= + (with-syntax-table emacs-lisp-mode-syntax-table=0A= + (let* ((strg (copy-sequence string))=0A= + (len-strg (length strg))=0A= + (ii 0)=0A= + (jj 0)=0A= + (newstrg "")=0A= + (re-command "\\\\\\[\\(\\(\\sw\\|\\s_\\)+\\)\\]")=0A= + (re-keymap "\\\\<\\(\\(\\sw\\|\\s_\\)+\\)>")=0A= + (re-bindings "\\\\{\\(\\(\\sw\\|\\s_\\)+\\)}")=0A= + (re-any (concat "\\(" re-command "\\|" re-keymap = "\\|" re-bindings "\\)"))=0A= + (keymap (or overriding-terminal-local-map = overriding-local-map))=0A= + (msg nil)=0A= + key bindings ma mc mk mb)=0A= + (while (< ii len-strg)=0A= + (setq key nil=0A= + bindings nil=0A= + strg (substring strg ii))=0A= + (save-match-data ; ANY=0A= + (setq ma (string-match re-any strg))=0A= + (if (not ma)=0A= + (setq newstrg (concat newstrg strg)=0A= + ii len-strg=0A= + jj len-strg)=0A= + (let ((escaped nil)=0A= + (odd nil))=0A= + (save-match-data=0A= + (let ((ma1 ma))=0A= + (setq ii ma)=0A= + (while (string-match "\\\\=3D$" (substring strg 0 = ma1))=0A= + (setq odd (not odd)=0A= + ma1 (match-beginning 0))=0A= + (when odd=0A= + (setq ii (- ii 2)=0A= + escaped ma1)))))=0A= + (if (not escaped)=0A= + (setq ii ma=0A= + jj (match-end 0)=0A= + ma (match-string-no-properties 0 strg)=0A= + newstrg (concat newstrg (substring strg 0 = ii)))=0A= + (setq jj (match-end 0) ; End of \[...], \{...}, = or \<...>=0A= + newstrg (if odd=0A= + (concat newstrg=0A= + (substring strg 0 ii) ; = Unescaped \=3D's=0A= + (substring strg ma jj)) ; = \[...], \{...}, or \<...>=0A= + (concat newstrg (substring strg 0 = ii)))=0A= + ma (if odd nil (match-string-no-properties = 0 strg))=0A= + ii jj)))))=0A= + (when ma=0A= + (save-match-data ; KEYMAP=0A= + (setq ma (copy-sequence ma))=0A= + (setq mk (string-match re-keymap ma))=0A= + (setq mk (and mk (match-string-no-properties 0 ma)))=0A= + (when mk=0A= + (setq keymap (intern (match-string-no-properties 1 ma)))=0A= + (if (boundp keymap)=0A= + (setq keymap (symbol-value keymap))=0A= + (setq msg (format "\nUses keymap \"%s\", which is not = currently defined.\n"=0A= + keymap))=0A= + (setq keymap (or overriding-terminal-local-map = overriding-local-map)))))=0A= + (unless mk ; COMMAND=0A= + (save-match-data=0A= + (setq ma (copy-sequence ma))=0A= + (setq mc (string-match re-command ma))=0A= + (setq mc (and mc (match-string-no-properties 0 ma)))=0A= + (setq mc (and mc (intern (substring mc 2 -1)))) ; = Remove \[...] envelope=0A= + (when mc=0A= + (let ((follow-remap t))=0A= + (while (and (setq key (where-is-internal mc keymap = 'FIRSTONLY))=0A= + (vectorp key) (> (length key) 1) (eq = 'remap (aref key 0))=0A= + (symbolp (aref key 1)) follow-remap)=0A= + (setq mc (aref key 1)=0A= + follow-remap nil)))=0A= + (setq key (if key (key-description key) (concat "M-x = " (symbol-name mc))))=0A= + (when add-help-buttons (setq key = (help-key-button-string key mc))))))=0A= + (unless (or mk mc) ; BINDINGS=0A= + (save-match-data=0A= + (setq ma (copy-sequence ma))=0A= + (setq mb (string-match re-bindings ma))=0A= + (setq mb (and mb (match-string-no-properties 0 ma)))=0A= + (when mb=0A= + (setq bindings (intern (match-string-no-properties 1 = ma)))=0A= + (cond ((boundp bindings)=0A= + (setq bindings (substitute-command-keys mb))) = ; Use original - no buttons.=0A= + (t=0A= + (setq msg (format "\nUses keymap \"%s\", which = is not currently defined.\n"=0A= + bindings))=0A= + (setq bindings nil))))))=0A= + (unless mk=0A= + (setq newstrg (concat newstrg (or key bindings (substring = strg ii jj)))))=0A= + (setq ii (or jj len-strg))))=0A= + (if (string=3D string newstrg)=0A= + string ; Return original string, not a copy, if no changes.=0A= + newstrg))))=0A= + =0A= + (defun help-key-button-string (key-description command)=0A= + "Return a button for KEY-DESCRIPTION that links to the COMMAND = description.=0A= + KEY-DESCRIPTION is a key-description string.=0A= + COMMAND is the command (a symbol) associated with the key described.=0A= + Return a copy of string KEY-DESCRIPTION with button properties added.=0A= + Clicking the button shows the help for COMMAND."=0A= + (let ((new-key (copy-sequence key-description)))=0A= + (make-text-button new-key nil 'button (list t) ':type = 'help-function 'help-args (list command))=0A= + new-key))=0A= + =0C=0A= =0A= (defun function-called-at-point ()=0A= "Return a function around point or else called by the list = containing point.=0A= ***************=0A= *** 852,858 ****=0A= "no indicator"=0A= (format "indicator%s"=0A= indicator))))=0A= ! (princ (documentation mode-function)))=0A= (insert-button pretty-minor-mode=0A= 'action (car help-button-cache)=0A= 'follow-link t=0A= --- 986,993 ----=0A= "no indicator"=0A= (format "indicator%s"=0A= indicator))))=0A= ! (with-current-buffer standard-output=0A= ! (insert (help-documentation mode-function nil = 'ADD-HELP-BUTTONS))))=0A= (insert-button pretty-minor-mode=0A= 'action (car help-button-cache)=0A= 'follow-link t=0A= ***************=0A= *** 880,886 ****=0A= (re-search-backward "`\\([^`']+\\)'" nil t)=0A= (help-xref-button 1 'help-function-def mode file-name)))))=0A= (princ ":\n")=0A= ! (princ (documentation major-mode)))))=0A= ;; For the sake of IELM and maybe others=0A= nil)=0A= =0A= --- 1015,1022 ----=0A= (re-search-backward "`\\([^`']+\\)'" nil t)=0A= (help-xref-button 1 'help-function-def mode file-name)))))=0A= (princ ":\n")=0A= ! (with-current-buffer standard-output=0A= ! (insert (help-documentation major-mode nil = 'ADD-HELP-BUTTONS))))))=0A= ;; For the sake of IELM and maybe others=0A= nil)=0A= =0A= =0A= Diff finished. Mon Jun 27 09:53:41 2011=0A= ------=_NextPart_000_0079_01CC3577.14941090 Content-Type: application/octet-stream; name="help-fns-2011-06-27.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="help-fns-2011-06-27.patch" diff -c -w help-fns.el help-fns-patched-2011-06-27.el=0A= *** help-fns.el Mon Jun 27 09:08:20 2011=0A= --- help-fns-patched-2011-06-27.el Mon Jun 27 09:51:14 2011=0A= ***************=0A= *** 527,533 ****=0A= (let* ((advertised (gethash def advertised-signature-table t))=0A= (arglist (if (listp advertised)=0A= advertised (help-function-arglist def)))=0A= ! (doc (condition-case err (documentation function)=0A= (error (format "No Doc! %S" err))))=0A= (usage (help-split-fundoc doc function)))=0A= (with-current-buffer standard-output=0A= --- 527,533 ----=0A= (let* ((advertised (gethash def advertised-signature-table t))=0A= (arglist (if (listp advertised)=0A= advertised (help-function-arglist def)))=0A= ! (doc (condition-case err (help-documentation function nil t)=0A= (error (format "No Doc! %S" err))))=0A= (usage (help-split-fundoc doc function)))=0A= (with-current-buffer standard-output=0A= ***************=0A= *** 545,551 ****=0A= (while (and (symbolp fun)=0A= (setq fun (symbol-function fun))=0A= (not (setq usage (help-split-fundoc=0A= ! (documentation fun)=0A= function)))))=0A= usage)=0A= (car usage))=0A= --- 545,551 ----=0A= (while (and (symbolp fun)=0A= (setq fun (symbol-function fun))=0A= (not (setq usage (help-split-fundoc=0A= ! (help-documentation fun nil t)=0A= function)))))=0A= usage)=0A= (car usage))=0A= ***************=0A= *** 786,793 ****=0A= (obsolete (get variable 'byte-obsolete-variable))=0A= (use (car obsolete))=0A= (safe-var (get variable 'safe-local-variable))=0A= ! (doc (or (documentation-property variable = 'variable-documentation)=0A= ! (documentation-property alias = 'variable-documentation)))=0A= (extra-line nil))=0A= ;; Add a note for variables that have been = make-var-buffer-local.=0A= (when (and (local-variable-if-set-p variable)=0A= --- 786,793 ----=0A= (obsolete (get variable 'byte-obsolete-variable))=0A= (use (car obsolete))=0A= (safe-var (get variable 'safe-local-variable))=0A= ! (doc (or (help-documentation-property variable = 'variable-documentation nil t)=0A= ! (help-documentation-property alias = 'variable-documentation nil t)))=0A= (extra-line nil))=0A= ;; Add a note for variables that have been = make-var-buffer-local.=0A= (when (and (local-variable-if-set-p variable)=0A= =0A= Diff finished. Mon Jun 27 09:52:12 2011=0A= ------=_NextPart_000_0079_01CC3577.14941090--