From 824fc04b660631e7ff976a36b7f70f7c3d5fc181 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 6 Jul 2015 13:25:26 -0400 Subject: [PATCH] (describe-symbol): Rewrite describe-function-or-variable * lisp/help-fns.el (describe-symbol-backends): New var. (help-xref-stack-item): Declare. (describe-symbol): Rename from describe-function-or-variable. Rewrite using describe-symbol-backends instead of help-xref-interned. * lisp/help.el (help-map): Use it. * lisp/help-mode.el (help-symbol, help-follow-symbol): Use it. (help-xref-interned): Make it into an obsolete alias. --- etc/NEWS | 2 ++ lisp/help-fns.el | 73 ++++++++++++++++++++++++++++++++++++++++++++----------- lisp/help-mode.el | 57 +++---------------------------------------- lisp/help.el | 2 +- 4 files changed, 65 insertions(+), 69 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7717fd02433..3ef5f824fd0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,6 +84,8 @@ command line when `initial-buffer-choice' is non-nil. * Changes in Emacs 25.1 +** New doc command `describe-symbol'. Works for functions, vars, faces, etc... + ** `isearch' and `query-replace' now perform character folding in matches. This is analogous to case-folding, but applies between Unicode characters and their ASCII counterparts. This means many characters diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 9541d4797b4..0a22c5ebcff 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -32,6 +32,8 @@ ;;; Code: +(require 'cl-lib) + (defvar help-fns-describe-function-functions nil "List of functions to run in help buffer in `describe-function'. Those functions will be run after the header line and argument @@ -968,13 +970,23 @@ file-local variable.\n") (buffer-string)))))))) +(defvar describe-symbol-backends + `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s))) + ("face" ,#'facep ,(lambda (s _b _f) (describe-face s))) + (nil + ,(lambda (symbol) + (or (and (boundp symbol) (not (keywordp symbol))) + (get symbol 'variable-documentation))) + ,#'describe-variable))) + +(defvar help-xref-stack-item) + ;;;###autoload -(defun describe-function-or-variable (symbol &optional buffer frame) - "Display the full documentation of the function or variable SYMBOL. -If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME -\(default to the current buffer and current frame), it is displayed along -with the global value." +(defun describe-symbol (symbol &optional buffer frame) + "Display the full documentation of SYMBOL. +Will show the info of SYMBOL as a function, variable, and/or face." (interactive + ;; FIXME: also let the user enter a face name. (let* ((v-or-f (variable-at-point)) (found (symbolp v-or-f)) (v-or-f (if found v-or-f (function-called-at-point))) @@ -983,21 +995,54 @@ with the global value." val) (setq val (completing-read (if found (format - "Describe function or variable (default %s): " v-or-f) - "Describe function or variable: ") + "Describe symbol (default %s): " v-or-f) + "Describe symbol: ") obarray (lambda (vv) - (or (fboundp vv) - (get vv 'variable-documentation) - (and (boundp vv) (not (keywordp vv))))) + (cl-some (lambda (x) (funcall (nth 1 x) vv)) + describe-symbol-backends)) t nil nil (if found (symbol-name v-or-f)))) (list (if (equal val "") v-or-f (intern val))))) - (if (not (symbolp symbol)) (message "You didn't specify a function or variable") - (unless (buffer-live-p buffer) (setq buffer (current-buffer))) - (unless (frame-live-p frame) (setq frame (selected-frame))) - (help-xref-interned symbol buffer frame))) + (if (not (symbolp symbol)) + (user-error "You didn't specify a function or variable")) + (unless (buffer-live-p buffer) (setq buffer (current-buffer))) + (unless (frame-live-p frame) (setq frame (selected-frame))) + (with-current-buffer (help-buffer) + ;; Push the previous item on the stack before clobbering the output buffer. + (help-setup-xref nil nil) + (let* ((docs + (nreverse + (delq nil + (mapcar (pcase-lambda (`(,name ,testfn ,descfn)) + (when (funcall testfn symbol) + ;; Don't record the current entry in the stack. + (setq help-xref-stack-item nil) + (cons name + (funcall descfn symbol buffer frame)))) + describe-symbol-backends)))) + (single (null (cdr docs)))) + (while (cdr docs) + (goto-char (point-min)) + (let ((inhibit-read-only t) + (name (caar docs)) ;Name of doc currently at BOB. + (doc (cdr (cadr docs)))) ;Doc to add at BOB. + (insert doc) + (delete-region (point) (progn (skip-chars-backward " \t\n") (point))) + (insert "\n\n" + (eval-when-compile + (propertize "\n" 'face '(:height 0.1 :inverse-video t))) + "\n") + (when name + (insert (symbol-name symbol) + " is also a " name "." "\n\n"))) + (setq docs (cdr docs))) + (unless single + ;; Don't record the `describe-variable' item in the stack. + (setq help-xref-stack-item nil) + (help-setup-xref (list #'describe-symbol symbol) nil)) + (goto-char (point-min))))) ;;;###autoload (defun describe-syntax (&optional buffer) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 6454eed27bd..cdddd542532 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -148,7 +148,7 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-symbol :supertype 'help-xref - 'help-function #'help-xref-interned + 'help-function #'describe-symbol 'help-echo (purecopy "mouse-2, RET: describe this symbol")) (define-button-type 'help-back @@ -624,58 +624,7 @@ See `help-make-xrefs'." ;; Additional functions for (re-)creating types of help buffers. ;;;###autoload -(defun help-xref-interned (symbol &optional buffer frame) - "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. -Both variable, function and face documentation are extracted into a single -help buffer. If SYMBOL is a variable, include buffer-local value for optional -BUFFER or FRAME." - (with-current-buffer (help-buffer) - ;; Push the previous item on the stack before clobbering the output buffer. - (help-setup-xref nil nil) - (let ((facedoc (when (facep symbol) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-face symbol))) - (fdoc (when (fboundp symbol) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-function symbol))) - (sdoc (when (or (boundp symbol) - (get symbol 'variable-documentation)) - ;; Don't record the current entry in the stack. - (setq help-xref-stack-item nil) - (describe-variable symbol buffer frame)))) - (cond - (sdoc - ;; We now have a help buffer on the variable. - ;; Insert the function and face text before it. - (when (or fdoc facedoc) - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (when fdoc - (insert fdoc "\n\n") - (when facedoc - (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "face." "\n\n"))) - (when facedoc - (insert facedoc "\n\n")) - (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "variable." "\n\n")) - ;; Don't record the `describe-variable' item in the stack. - (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil))) - (fdoc - ;; We now have a help buffer on the function. - ;; Insert face text before it. - (when facedoc - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol) - " is also a " "face." "\n\n" facedoc)) - ;; Don't record the `describe-function' item in the stack. - (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil)))) - (goto-char (point-min))))) +(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1") ;; Navigation/hyperlinking with xrefs @@ -774,7 +723,7 @@ Show all docs for that symbol as either a variable, function or face." (when (or (boundp sym) (get sym 'variable-documentation) (fboundp sym) (facep sym)) - (help-do-xref pos #'help-xref-interned (list sym))))) + (help-do-xref pos #'describe-symbol (list sym))))) (defun help-mode-revert-buffer (_ignore-auto noconfirm) (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) diff --git a/lisp/help.el b/lisp/help.el index 7a3460c1b3d..1826cb7219a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -95,7 +95,7 @@ (define-key map "k" 'describe-key) (define-key map "l" 'view-lossage) (define-key map "m" 'describe-mode) - (define-key map "o" 'describe-function-or-variable) + (define-key map "o" 'describe-symbol) (define-key map "n" 'view-emacs-news) (define-key map "p" 'finder-by-keyword) (define-key map "P" 'describe-package) -- 2.11.4.GIT