;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2016 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;;; Code:
+(require 'cl-lib)
+(require 'help-mode)
+
(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
;; Functions
+(defvar describe-function-orig-buffer nil
+ "Buffer that was current when `describe-function' was invoked.
+Functions on `help-fns-describe-function-functions' can use this
+to get buffer-local values.")
+
;;;###autoload
(defun describe-function (function)
"Display the full documentation of FUNCTION (a symbol)."
(user-error "You didn't specify a function symbol"))
(or (fboundp function)
(user-error "Symbol's function definition is void: %s" function))
- (help-setup-xref (list #'describe-function function)
- (called-interactively-p 'interactive))
- (save-excursion
- (with-help-window (help-buffer)
- (prin1 function)
- ;; Use " is " instead of a colon so that
- ;; it is easier to get out the function name using forward-sexp.
- (princ " is ")
- (describe-function-1 function)
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string)))))
+
+ ;; We save describe-function-orig-buffer on the help xref stack, so
+ ;; it is restored by the back/forward buttons. 'help-buffer'
+ ;; expects (current-buffer) to be a help buffer when processing
+ ;; those buttons, so we can't change the current buffer before
+ ;; calling that.
+ (let ((describe-function-orig-buffer
+ (or describe-function-orig-buffer
+ (current-buffer))))
+
+ (help-setup-xref
+ (list (lambda (function buffer)
+ (let ((describe-function-orig-buffer
+ (if (buffer-live-p buffer) buffer)))
+ (describe-function function)))
+ function describe-function-orig-buffer)
+ (called-interactively-p 'interactive))
+
+ (save-excursion
+ (with-help-window (help-buffer)
+ (prin1 function)
+ ;; Use " is " instead of a colon so that
+ ;; it is easier to get out the function name using forward-sexp.
+ (princ " is ")
+ (describe-function-1 function)
+ (with-current-buffer standard-output
+ ;; Return the text we displayed.
+ (buffer-string))))
+ ))
;; Could be this, if we make symbol-file do the work below.
(skip-chars-forward "^ ")
(while next
(or opt (not (looking-at " &")) (setq opt t))
- (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
+ (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &).]+\\)" nil t))
(setq next nil)
(setq args (cons (match-string 2) args))
(when (and opt (string= (match-string 1) "("))
(substring-no-properties lib-name 0 -1)
lib-name)
file-name))
- ;; The next three forms are from `find-source-lisp-file'.
- (elc-file (locate-file
- (concat file-name
- (if (string-match "\\.el\\'" file-name)
- "c"
- ".elc"))
- load-path nil 'readable))
- (str (when elc-file
- (with-temp-buffer
- (insert-file-contents-literally elc-file nil 0 256)
- (buffer-string))))
- (src-file (and str
- (string-match ";;; from file \\(.*\\.el\\)" str)
- (match-string 1 str))))
+ (src-file (locate-library file-name t nil 'readable)))
(and src-file (file-readable-p src-file) src-file))))))
(defun help-fns--key-bindings (function)
(when remapped
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
- (concat (substitute-command-keys "‘")
- (symbol-name remapped)
- (substitute-command-keys "’"))
+ (format-message "`%s'" remapped)
"an anonymous command"))
(princ ".\n"))
(insert "\nThis function has a compiler macro")
(if (symbolp handler)
(progn
- (insert (format (substitute-command-keys " ‘%s’") handler))
+ (insert (format-message " `%s'" handler))
(save-excursion
- (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function handler)))
;; FIXME: Obsolete since 24.4.
(let ((lib (get function 'compiler-macro-file)))
(when (stringp lib)
- (insert (format (substitute-command-keys " in ‘%s’") lib))
+ (insert (format-message " in `%s'" lib))
(save-excursion
- (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function-cmacro function lib)))))
(insert ".\n"))))
-(defun help-fns--signature (function doc real-def real-function raw)
+(defun help-fns--signature (function doc real-def real-function buffer)
"Insert usage at point and return docstring. With highlighting."
(if (keymapp function)
doc ; If definition is a keymap, skip arglist note.
(use1 (replace-regexp-in-string
"\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'"
"\\\\=`\\1" use t))
- (high (if raw
- (cons use1 doc)
- (help-highlight-arguments (substitute-command-keys use1)
- (substitute-command-keys doc)))))
+ (high (if buffer
+ (let (subst-use1 subst-doc)
+ (with-current-buffer buffer
+ (setq subst-use1 (substitute-command-keys use1))
+ (setq subst-doc (substitute-command-keys doc)))
+ (help-highlight-arguments subst-use1 subst-doc))
+ (cons use1 doc))))
(let ((fill-begin (point))
(high-usage (car high))
(high-doc (cdr high)))
(get function
'derived-mode-parent))))
(when parent-mode
- (insert (substitute-command-keys "\nParent mode: ‘"))
+ (insert (substitute-command-keys "\nParent mode: `"))
(let ((beg (point)))
(insert (format "%s" parent-mode))
(make-text-button beg (point)
'type 'help-function
'help-args (list parent-mode)))
- (insert (substitute-command-keys "’.\n")))))
+ (insert (substitute-command-keys "'.\n")))))
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
- (use (format (substitute-command-keys
- ";\nuse ‘%s’ instead.")
- use))
+ (use (format-message ";\nuse `%s' instead." use))
(t "."))
"\n"))))
(format ";\nin Lisp code %s" interactive-only))
((and (symbolp 'interactive-only)
(not (eq interactive-only t)))
- (format (substitute-command-keys
- ";\nin Lisp code use ‘%s’ instead.")
- interactive-only))
+ (format-message ";\nin Lisp code use `%s' instead."
+ interactive-only))
(t "."))
"\n")))))
;; Aliases are Lisp functions, so we need to check
;; aliases before functions.
(aliased
- (format (substitute-command-keys "an alias for ‘%s’")
- real-def))
+ (format-message "an alias for `%s'" real-def))
((autoloadp def)
(format "%s autoloaded %s"
(if (commandp def) "an interactive" "an")
(save-excursion
(save-match-data
(when (re-search-backward (substitute-command-keys
- "alias for ‘\\([^‘’]+\\)’")
+ "alias for `\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function real-def)))))
(when file-name
- (princ (substitute-command-keys " in ‘"))
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
- (princ (if (eq file-name 'C-source)
- "C source code"
- (help-fns-short-filename file-name)))
- (princ (substitute-command-keys "’"))
+ (princ (format-message " in `%s'"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (help-fns-short-filename file-name))))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
- (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’")
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(point)))
(terpri)(terpri)
- (let ((doc-raw (documentation function t)))
+ (let ((doc-raw (documentation function t))
+ (key-bindings-buffer (current-buffer)))
;; If the function is autoloaded, and its docstring has
;; key substitution constructs, load the library.
(help-fns--key-bindings function)
(with-current-buffer standard-output
- (let ((doc (help-fns--signature function doc-raw sig-key
- real-function nil)))
- (run-hook-with-args 'help-fns-describe-function-functions function)
- (insert "\n"
- (or doc "Not documented."))))))))
+ (let ((doc (help-fns--signature function doc-raw sig-key
+ real-function key-bindings-buffer)))
+ (run-hook-with-args 'help-fns-describe-function-functions function)
+ (insert "\n"
+ (or doc "Not documented."))
+ ;; Avoid asking the user annoying questions if she decides
+ ;; to save the help buffer, when her locale's codeset
+ ;; isn't UTF-8.
+ (unless (memq text-quoting-style '(straight grave))
+ (set-buffer-file-coding-system 'utf-8))))))))
;; Add defaults to `help-fns-describe-function-functions'.
(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
(if file-name
(progn
- (princ (substitute-command-keys
- " is a variable defined in ‘"))
- (princ (if (eq file-name 'C-source)
- "C source code"
- (file-name-nondirectory file-name)))
- (princ (substitute-command-keys "’.\n"))
+ (princ (format-message
+ " is a variable defined in `%s'.\n"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (file-name-nondirectory file-name))))
(with-current-buffer standard-output
(save-excursion
(re-search-backward (substitute-command-keys
- "‘\\([^‘’]+\\)’")
+ "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-variable-def
variable file-name)))
(princ "Its ")))
(if valvoid
(princ " is void as a variable.")
- (princ "'s "))))
+ (princ (substitute-command-keys "'s ")))))
(unless valvoid
(with-current-buffer standard-output
(setq val-start-pos (point))
(let ((from (point))
(line-beg (line-beginning-position))
(print-rep
- (let ((print-quoted t))
- (prin1-to-string val))))
+ (let ((rep
+ (let ((print-quoted t))
+ (prin1-to-string val))))
+ (if (and (symbolp val) (not (booleanp val)))
+ (format-message "`%s'" rep)
+ rep))))
(if (< (+ (length print-rep) (point) (- line-beg)) 68)
(insert print-rep)
(terpri)
((not permanent-local))
((bufferp locus)
(setq extra-line t)
- (princ " This variable's buffer-local value is permanent.\n"))
+ (princ
+ (substitute-command-keys
+ " This variable's buffer-local value is permanent.\n")))
(t
(setq extra-line t)
- (princ " This variable's value is permanent \
-if it is given a local binding.\n")))
+ (princ (substitute-command-keys
+ " This variable's value is permanent \
+if it is given a local binding.\n"))))
;; Mention if it's an alias.
(unless (eq alias variable)
(setq extra-line t)
- (princ (format (substitute-command-keys
- " This variable is an alias for ‘%s’.\n")
- alias)))
+ (princ (format-message
+ " This variable is an alias for `%s'.\n"
+ alias)))
(when obsolete
(setq extra-line t)
(if (nth 2 obsolete)
(princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
- (use (format (substitute-command-keys
- ";\n use ‘%s’ instead.")
- (car obsolete)))
+ (use (format-message ";\n use `%s' instead."
+ (car obsolete)))
(t ".")))
(terpri))
(dir-locals-find-file
(buffer-file-name buffer))))
(dir-file t))
- (princ " This variable's value is directory-local")
+ (princ (substitute-command-keys
+ " This variable's value is directory-local"))
(if (null file)
(princ ".\n")
(princ ", set ")
dir-file nil)))
(princ (substitute-command-keys
(if dir-file
- "by the file\n ‘"
- "for the directory\n ‘")))
+ "by the file\n `"
+ "for the directory\n `")))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
'help-args (list variable file)))
- (princ (substitute-command-keys "’.\n"))))
- (princ " This variable's value is file-local.\n")))
+ (princ (substitute-command-keys "'.\n"))))
+ (princ (substitute-command-keys
+ " This variable's value is file-local.\n"))))
(when (memq variable ignored-local-variables)
(setq extra-line t)
(when (assq variable safe-local-variable-values)
(princ (substitute-command-keys
" However, you have added it to \
-‘safe-local-variable-values’.\n"))))
+`safe-local-variable-values'.\n"))))
(when safe-var
(setq extra-line t)
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
"which is a byte-compiled expression.\n"
- (format (substitute-command-keys "‘%s’.\n")
- safe-var))))
+ (format-message "`%s'.\n" safe-var))))
(if extra-line (terpri))
(princ "Documentation:\n")
(re-search-backward
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-variable variable))))
- ;; Note variable's version or package version
+ ;; Note variable's version or package version.
(let ((output (describe-variable-custom-version-info variable)))
(when output
(terpri)
(buffer-string))))))))
+(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.
+Optional arguments BUFFER and FRAME specify for which buffer and
+frame to show the information about SYMBOL; they default to the
+current buffer and the selected frame, respectively."
(interactive
- (let* ((v-or-f (variable-at-point))
- (found (symbolp v-or-f))
+ (let* ((v-or-f (symbol-at-point))
+ (found (cl-some (lambda (x) (funcall (nth 1 x) v-or-f))
+ describe-symbol-backends))
(v-or-f (if found v-or-f (function-called-at-point)))
(found (or found v-or-f))
(enable-recursive-minibuffers t)
- val)
- (setq val (completing-read (if found
+ (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))))
+ (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.
+ (when doc
+ (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)