* Proposal: font lock for `describe-variable`
@ 2016-09-25 3:36 Tianxiang Xiong
2016-09-25 14:47 ` Clément Pit--Claudel
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-25 3:36 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 359 bytes --]
I've modified `describe-mode` to font-lock values as appropriate, and also
cleaned up the code a bit. The changes should be self-evident.
Right now I'm thinking about linking some of the more technical terms (e.g.
"permanently local") to the Emacs Info manual. What is the right way to
xref to Info manual nodes in the Help buffer?
Thanks,
Tianxiang Xiong
[-- Attachment #1.2: Type: text/html, Size: 471 bytes --]
[-- Attachment #2: 0001-Use-font-lock-for-describe-variable.patch --]
[-- Type: text/x-patch, Size: 56776 bytes --]
From d3b92616f35bef618016234bf158237b58a5a413 Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
Date: Sat, 24 Sep 2016 19:57:21 -0700
Subject: [PATCH] Use font-lock for `describe-variable`
As a side effect, clean up code.
---
lisp/help-fns.el | 1052 ++++++++++++++++++++++++++----------------------------
1 file changed, 504 insertions(+), 548 deletions(-)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e4e2333..083db5f 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -35,6 +35,7 @@
(require 'cl-lib)
(require 'help-mode)
(require 'radix-tree)
+(require 'subr-x)
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
@@ -109,16 +110,16 @@ describe-function
"Display the full documentation of FUNCTION (a symbol)."
(interactive
(let ((fn (function-called-at-point))
- (enable-recursive-minibuffers t)
- val)
+ (enable-recursive-minibuffers t)
+ val)
(setq val (completing-read (if fn
- (format "Describe function (default %s): " fn)
- "Describe function: ")
- #'help--symbol-completion-table
+ (format "Describe function (default %s): " fn)
+ "Describe function: ")
+ #'help--symbol-completion-table
#'fboundp
t nil nil (and fn (symbol-name fn))))
(list (if (equal val "")
- fn (intern val)))))
+ fn (intern val)))))
(or (and function (symbolp function))
(user-error "You didn't specify a function symbol"))
(or (fboundp function)
@@ -159,36 +160,36 @@ describe-function
;; "Return the name of the C file where SUBR-OR-VAR is defined.
;; KIND should be `var' for a variable or `subr' for a subroutine."
;; (symbol-file (if (symbolp subr-or-var) subr-or-var
-;; (subr-name subr-or-var))
-;; (if (eq kind 'var) 'defvar 'defun)))
+;; (subr-name subr-or-var))
+;; (if (eq kind 'var) 'defvar 'defun)))
;;;###autoload
(defun help-C-file-name (subr-or-var kind)
"Return the name of the C file where SUBR-OR-VAR is defined.
KIND should be `var' for a variable or `subr' for a subroutine."
(let ((docbuf (get-buffer-create " *DOC*"))
- (name (if (eq 'var kind)
- (concat "V" (symbol-name subr-or-var))
- (concat "F" (subr-name (advice--cd*r subr-or-var))))))
+ (name (if (eq 'var kind)
+ (concat "V" (symbol-name subr-or-var))
+ (concat "F" (subr-name (advice--cd*r subr-or-var))))))
(with-current-buffer docbuf
(goto-char (point-min))
(if (eobp)
- (insert-file-contents-literally
- (expand-file-name internal-doc-file-name doc-directory)))
+ (insert-file-contents-literally
+ (expand-file-name internal-doc-file-name doc-directory)))
(let ((file (catch 'loop
- (while t
- (let ((pnt (search-forward (concat "\x1f" name "\n"))))
- (re-search-backward "\x1fS\\(.*\\)")
- (let ((file (match-string 1)))
- (if (member file build-files)
- (throw 'loop file)
- (goto-char pnt))))))))
- (if (string-match "^ns.*\\(\\.o\\|obj\\)\\'" file)
- (setq file (replace-match ".m" t t file 1))
- (if (string-match "\\.\\(o\\|obj\\)\\'" file)
- (setq file (replace-match ".c" t t file))))
- (if (string-match "\\.\\(c\\|m\\)\\'" file)
- (concat "src/" file)
- file)))))
+ (while t
+ (let ((pnt (search-forward (concat "\x1f" name "\n"))))
+ (re-search-backward "\x1fS\\(.*\\)")
+ (let ((file (match-string 1)))
+ (if (member file build-files)
+ (throw 'loop file)
+ (goto-char pnt))))))))
+ (if (string-match "^ns.*\\(\\.o\\|obj\\)\\'" file)
+ (setq file (replace-match ".m" t t file 1))
+ (if (string-match "\\.\\(o\\|obj\\)\\'" file)
+ (setq file (replace-match ".c" t t file))))
+ (if (string-match "\\.\\(c\\|m\\)\\'" file)
+ (concat "src/" file)
+ file)))))
(defcustom help-downcase-arguments nil
"If non-nil, argument names in *Help* buffers are downcased."
@@ -201,7 +202,7 @@ help-highlight-arg
Return ARG in face `help-argument-name'; ARG is also downcased
if the variable `help-downcase-arguments' is non-nil."
(propertize (if help-downcase-arguments (downcase arg) arg)
- 'face 'help-argument-name))
+ 'face 'help-argument-name))
(defun help-do-arg-highlight (doc args)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
@@ -275,50 +276,50 @@ find-lisp-object-file-name
means that OBJECT is a function or variable defined in C. If no
suitable file is found, return nil."
(let* ((autoloaded (autoloadp type))
- (file-name (or (and autoloaded (nth 1 type))
- (symbol-file
+ (file-name (or (and autoloaded (nth 1 type))
+ (symbol-file
;; FIXME: Why do we have this weird "If TYPE is the
;; value returned by `symbol-function' for a function
;; symbol" exception?
- object (or (if (symbolp type) type) 'defun)))))
+ object (or (if (symbolp type) type) 'defun)))))
(cond
(autoloaded
;; An autoloaded function: Locate the file since `symbol-function'
;; has only returned a bare string here.
(setq file-name
- (locate-file file-name load-path '(".el" ".elc") 'readable)))
+ (locate-file file-name load-path '(".el" ".elc") 'readable)))
((and (stringp file-name)
- (string-match "[.]*loaddefs.el\\'" file-name))
+ (string-match "[.]*loaddefs.el\\'" file-name))
;; An autoloaded variable or face. Visit loaddefs.el in a buffer
;; and try to extract the defining file. The following form is
;; from `describe-function-1' and `describe-variable'.
(let ((location
- (condition-case nil
- (find-function-search-for-symbol object nil file-name)
- (error nil))))
- (when (cdr location)
- (with-current-buffer (car location)
- (goto-char (cdr location))
- (when (re-search-backward
- "^;;; Generated autoloads from \\(.*\\)" nil t)
- (setq file-name
- (locate-file
- (file-name-sans-extension
- (match-string-no-properties 1))
- load-path '(".el" ".elc") 'readable))))))))
+ (condition-case nil
+ (find-function-search-for-symbol object nil file-name)
+ (error nil))))
+ (when (cdr location)
+ (with-current-buffer (car location)
+ (goto-char (cdr location))
+ (when (re-search-backward
+ "^;;; Generated autoloads from \\(.*\\)" nil t)
+ (setq file-name
+ (locate-file
+ (file-name-sans-extension
+ (match-string-no-properties 1))
+ load-path '(".el" ".elc") 'readable))))))))
(cond
((and (not file-name) (subrp type))
;; A built-in function. The form is from `describe-function-1'.
(if (get-buffer " *DOC*")
- (help-C-file-name type 'subr)
- 'C-source))
+ (help-C-file-name type 'subr)
+ 'C-source))
((and (not file-name) (symbolp object)
- (integerp (get object 'variable-documentation)))
+ (integerp (get object 'variable-documentation)))
;; A variable defined in C. The form is from `describe-variable'.
(if (get-buffer " *DOC*")
- (help-C-file-name object 'var)
- 'C-source))
+ (help-C-file-name object 'var)
+ 'C-source))
((not (stringp file-name))
;; If we don't have a file-name string by now, we lost.
nil)
@@ -327,34 +328,34 @@ find-lisp-object-file-name
;; This applies to config files like ~/.emacs,
;; which people sometimes compile.
((let (fn)
- (and (string-match "\\`\\..*\\.elc\\'"
- (file-name-nondirectory file-name))
- (string-equal (file-name-directory file-name)
- (file-name-as-directory (expand-file-name "~")))
- (file-readable-p (setq fn (file-name-sans-extension file-name)))
- fn)))
+ (and (string-match "\\`\\..*\\.elc\\'"
+ (file-name-nondirectory file-name))
+ (string-equal (file-name-directory file-name)
+ (file-name-as-directory (expand-file-name "~")))
+ (file-readable-p (setq fn (file-name-sans-extension file-name)))
+ fn)))
;; When the Elisp source file can be found in the install
;; directory, return the name of that file.
((let ((lib-name
- (if (string-match "[.]elc\\'" file-name)
- (substring-no-properties file-name 0 -1)
- file-name)))
- (or (and (file-readable-p lib-name) lib-name)
- ;; The library might be compressed.
- (and (file-readable-p (concat lib-name ".gz")) lib-name))))
+ (if (string-match "[.]elc\\'" file-name)
+ (substring-no-properties file-name 0 -1)
+ file-name)))
+ (or (and (file-readable-p lib-name) lib-name)
+ ;; The library might be compressed.
+ (and (file-readable-p (concat lib-name ".gz")) lib-name))))
((let* ((lib-name (file-name-nondirectory file-name))
- ;; The next form is from `describe-simplify-lib-file-name'.
- (file-name
- ;; Try converting the absolute file name to a library
- ;; name, convert that back to a file name and see if we
- ;; get the original one. If so, they are equivalent.
- (if (equal file-name (locate-file lib-name load-path '("")))
- (if (string-match "[.]elc\\'" lib-name)
- (substring-no-properties lib-name 0 -1)
- lib-name)
- file-name))
- (src-file (locate-library file-name t nil 'readable)))
- (and src-file (file-readable-p src-file) src-file))))))
+ ;; The next form is from `describe-simplify-lib-file-name'.
+ (file-name
+ ;; Try converting the absolute file name to a library
+ ;; name, convert that back to a file name and see if we
+ ;; get the original one. If so, they are equivalent.
+ (if (equal file-name (locate-file lib-name load-path '("")))
+ (if (string-match "[.]elc\\'" lib-name)
+ (substring-no-properties lib-name 0 -1)
+ lib-name)
+ file-name))
+ (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 (commandp function)
@@ -376,7 +377,7 @@ help-fns--key-bindings
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
(format-message "`%s'" remapped)
- "an anonymous command"))
+ "an anonymous command"))
(princ ".\n"))
(when keys
@@ -489,14 +490,14 @@ help-fns--parent-mode
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
(let* ((obsolete (and (symbolp function)
- (get function 'byte-obsolete-info)))
+ (get function 'byte-obsolete-info)))
(use (car obsolete)))
(when obsolete
(insert "\nThis "
- (if (eq (car-safe (symbol-function function)) 'macro)
- "macro"
- "function")
- " is obsolete")
+ (if (eq (car-safe (symbol-function function)) 'macro)
+ "macro"
+ "function")
+ " is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
@@ -509,13 +510,13 @@ help-fns--autoloaded-p
"Return non-nil if FUNCTION has previously been autoloaded.
FILE is the file where FUNCTION was probably defined."
(let* ((file (file-name-sans-extension (file-truename file)))
- (load-hist load-history)
- (target (cons t function))
- found)
+ (load-hist load-history)
+ (target (cons t function))
+ found)
(while (and load-hist (not found))
(and (caar load-hist)
- (equal (file-name-sans-extension (caar load-hist)) file)
- (setq found (member target (cdar load-hist))))
+ (equal (file-name-sans-extension (caar load-hist)) file)
+ (setq found (member target (cdar load-hist))))
(setq load-hist (cdr load-hist)))
found))
@@ -556,128 +557,128 @@ help-fns-short-filename
;;;###autoload
(defun describe-function-1 (function)
(let* ((advised (and (symbolp function)
- (featurep 'nadvice)
- (advice--p (advice--symbol-function function))))
- ;; If the function is advised, use the symbol that has the
- ;; real definition, if that symbol is already set up.
- (real-function
- (or (and advised
+ (featurep 'nadvice)
+ (advice--p (advice--symbol-function function))))
+ ;; If the function is advised, use the symbol that has the
+ ;; real definition, if that symbol is already set up.
+ (real-function
+ (or (and advised
(advice--cd*r (advice--symbol-function function)))
- function))
- ;; Get the real definition.
- (def (if (symbolp real-function)
- (or (symbol-function real-function)
- (signal 'void-function (list real-function)))
- real-function))
- (aliased (or (symbolp def)
- ;; Advised & aliased function.
- (and advised (symbolp real-function)
- (not (eq 'autoload (car-safe def))))
+ function))
+ ;; Get the real definition.
+ (def (if (symbolp real-function)
+ (or (symbol-function real-function)
+ (signal 'void-function (list real-function)))
+ real-function))
+ (aliased (or (symbolp def)
+ ;; Advised & aliased function.
+ (and advised (symbolp real-function)
+ (not (eq 'autoload (car-safe def))))
(and (subrp def)
(not (string= (subr-name def)
(symbol-name function))))))
- (real-def (cond
+ (real-def (cond
((and aliased (not (subrp def)))
(let ((f real-function))
(while (and (fboundp f)
(symbolp (symbol-function f)))
(setq f (symbol-function f)))
f))
- ((subrp def) (intern (subr-name def)))
- (t def)))
- (sig-key (if (subrp def)
+ ((subrp def) (intern (subr-name def)))
+ (t def)))
+ (sig-key (if (subrp def)
(indirect-function real-def)
real-def))
- (file-name (find-lisp-object-file-name function (if aliased 'defun
+ (file-name (find-lisp-object-file-name function (if aliased 'defun
def)))
(pt1 (with-current-buffer (help-buffer) (point)))
- (beg (if (and (or (byte-code-function-p def)
- (keymapp def)
- (memq (car-safe def) '(macro lambda closure)))
- (stringp file-name)
- (help-fns--autoloaded-p function file-name))
- (if (commandp def)
- "an interactive autoloaded "
- "an autoloaded ")
- (if (commandp def) "an interactive " "a "))))
+ (beg (if (and (or (byte-code-function-p def)
+ (keymapp def)
+ (memq (car-safe def) '(macro lambda closure)))
+ (stringp file-name)
+ (help-fns--autoloaded-p function file-name))
+ (if (commandp def)
+ "an interactive autoloaded "
+ "an autoloaded ")
+ (if (commandp def) "an interactive " "a "))))
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
- "a keyboard macro")
- ;; Aliases are Lisp functions, so we need to check
- ;; aliases before functions.
- (aliased
- (format-message "an alias for `%s'" real-def))
- ((subrp def)
- (if (eq 'unevalled (cdr (subr-arity def)))
- (concat beg "special form")
- (concat beg "built-in function")))
- ((autoloadp def)
- (format "%s autoloaded %s"
- (if (commandp def) "an interactive" "an")
- (if (eq (nth 4 def) 'keymap) "keymap"
- (if (nth 4 def) "Lisp macro" "Lisp function"))))
- ((or (eq (car-safe def) 'macro)
- ;; For advised macros, def is a lambda
- ;; expression or a byte-code-function-p, so we
- ;; need to check macros before functions.
- (macrop function))
- (concat beg "Lisp macro"))
- ((byte-code-function-p def)
- (concat beg "compiled Lisp function"))
- ((eq (car-safe def) 'lambda)
- (concat beg "Lisp function"))
- ((eq (car-safe def) 'closure)
- (concat beg "Lisp closure"))
- ((keymapp def)
- (let ((is-full nil)
- (elts (cdr-safe def)))
- (while elts
- (if (char-table-p (car-safe elts))
- (setq is-full t
- elts nil))
- (setq elts (cdr-safe elts)))
- (concat beg (if is-full "keymap" "sparse keymap"))))
- (t "")))
+ "a keyboard macro")
+ ;; Aliases are Lisp functions, so we need to check
+ ;; aliases before functions.
+ (aliased
+ (format-message "an alias for `%s'" real-def))
+ ((subrp def)
+ (if (eq 'unevalled (cdr (subr-arity def)))
+ (concat beg "special form")
+ (concat beg "built-in function")))
+ ((autoloadp def)
+ (format "%s autoloaded %s"
+ (if (commandp def) "an interactive" "an")
+ (if (eq (nth 4 def) 'keymap) "keymap"
+ (if (nth 4 def) "Lisp macro" "Lisp function"))))
+ ((or (eq (car-safe def) 'macro)
+ ;; For advised macros, def is a lambda
+ ;; expression or a byte-code-function-p, so we
+ ;; need to check macros before functions.
+ (macrop function))
+ (concat beg "Lisp macro"))
+ ((byte-code-function-p def)
+ (concat beg "compiled Lisp function"))
+ ((eq (car-safe def) 'lambda)
+ (concat beg "Lisp function"))
+ ((eq (car-safe def) 'closure)
+ (concat beg "Lisp closure"))
+ ((keymapp def)
+ (let ((is-full nil)
+ (elts (cdr-safe def)))
+ (while elts
+ (if (char-table-p (car-safe elts))
+ (setq is-full t
+ elts nil))
+ (setq elts (cdr-safe elts)))
+ (concat beg (if is-full "keymap" "sparse keymap"))))
+ (t "")))
(if (and aliased (not (fboundp real-def)))
- (princ ",\nwhich is not defined. Please make a bug report.")
+ (princ ",\nwhich is not defined. Please make a bug report.")
(with-current-buffer standard-output
- (save-excursion
- (save-match-data
- (when (re-search-backward (substitute-command-keys
+ (save-excursion
+ (save-match-data
+ (when (re-search-backward (substitute-command-keys
"alias for `\\([^`']+\\)'")
nil t)
- (help-xref-button 1 'help-function real-def)))))
+ (help-xref-button 1 'help-function real-def)))))
(when file-name
- ;; We used to add .el to the file name,
- ;; but that's completely wrong when the user used load-file.
- (princ (format-message " in `%s'"
+ ;; We used to add .el to the file name,
+ ;; but that's completely wrong when the user used load-file.
+ (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 "`\\([^`']+\\)'")
+ ;; Make a hyperlink to the library.
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
- (help-xref-button 1 'help-function-def function file-name))))
+ (help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(with-current-buffer (help-buffer)
- (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
- (point)))
+ (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
+ (point)))
(terpri)(terpri)
(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.
- (and (autoloadp real-def) doc-raw
- help-enable-auto-load
- (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
- (autoload-do-load real-def))
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (and (autoloadp real-def) doc-raw
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+ (autoload-do-load real-def))
(help-fns--key-bindings function)
(with-current-buffer standard-output
@@ -708,15 +709,15 @@ variable-at-point
If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(with-syntax-table emacs-lisp-mode-syntax-table
(or (condition-case ()
- (save-excursion
- (skip-chars-forward "'")
- (or (not (zerop (skip-syntax-backward "_w")))
- (eq (char-syntax (following-char)) ?w)
- (eq (char-syntax (following-char)) ?_)
- (forward-sexp -1))
- (skip-chars-forward "'")
- (let ((obj (read (current-buffer))))
- (and (symbolp obj) (boundp obj) obj)))
+ (save-excursion
+ (skip-chars-forward "'")
+ (or (not (zerop (skip-syntax-backward "_w")))
+ (eq (char-syntax (following-char)) ?w)
+ (eq (char-syntax (following-char)) ?_)
+ (forward-sexp -1))
+ (skip-chars-forward "'")
+ (let ((obj (read (current-buffer))))
+ (and (symbolp obj) (boundp obj) obj)))
(error nil))
(let* ((str (find-tag-default))
(sym (if str (intern-soft str))))
@@ -730,337 +731,292 @@ variable-at-point
(defun describe-variable-custom-version-info (variable)
(let ((custom-version (get variable 'custom-version))
- (cpv (get variable 'custom-package-version))
- (output nil))
+ (cpv (get variable 'custom-package-version))
+ (output nil))
(if custom-version
- (setq output
- (format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
- custom-version))
+ (setq output
+ (format "This variable was introduced, or its default value was changed, in version %s of Emacs.\n"
+ custom-version))
(when cpv
- (let* ((package (car-safe cpv))
- (version (if (listp (cdr-safe cpv))
- (car (cdr-safe cpv))
- (cdr-safe cpv)))
- (pkg-versions (assq package customize-package-emacs-version-alist))
- (emacsv (cdr (assoc version pkg-versions))))
- (if (and package version)
- (setq output
- (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
- (if emacsv
- (format " that is part of Emacs %s" emacsv))
- ".\n")
- version package))))))
+ (let* ((package (car-safe cpv))
+ (version (if (listp (cdr-safe cpv))
+ (car (cdr-safe cpv))
+ (cdr-safe cpv)))
+ (pkg-versions (assq package customize-package-emacs-version-alist))
+ (emacsv (cdr (assoc version pkg-versions))))
+ (if (and package version)
+ (setq output
+ (format (concat "This variable was introduced, or its default value was changed, in version %s of the %s package"
+ (if emacsv
+ (format " that is part of Emacs %s" emacsv))
+ ".\n")
+ version package))))))
output))
;;;###autoload
(defun describe-variable (variable &optional buffer frame)
"Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also.
-If VARIABLE 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."
+
+Returns the documentation as a string.
+
+If VARIABLE has a buffer-local value in BUFFER or FRAME (default
+to the current buffer and frame), it is displayed along
+with the global value."
(interactive
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- (orig-buffer (current-buffer))
- val)
- (setq val (completing-read
+ (let* ((v (variable-at-point))
+ (enable-recursive-minibuffers t)
+ (orig-buffer (current-buffer))
+ (val (completing-read
(if (symbolp v)
(format
"Describe variable (default %s): " v)
"Describe variable: ")
#'help--symbol-completion-table
(lambda (vv)
- ;; In case the variable only exists in the buffer
- ;; the command we switch back to that buffer before
- ;; we examine the variable.
(with-current-buffer orig-buffer
(or (get vv 'variable-documentation)
(and (boundp vv) (not (keywordp vv))))))
- t nil nil
- (if (symbolp v) (symbol-name v))))
- (list (if (equal val "")
- v (intern val)))))
- (let (file-name)
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (if (not (symbolp variable))
- (message "You did not specify a variable")
- (save-excursion
- (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- (permanent-local (get variable 'permanent-local))
- val val-start-pos locus)
- ;; Extract the value before setting up the output buffer,
- ;; in case `buffer' *is* the output buffer.
- (unless valvoid
- (with-selected-frame frame
- (with-current-buffer buffer
- (setq val (symbol-value variable)
- locus (variable-binding-locus variable)))))
- (help-setup-xref (list #'describe-variable variable buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (prin1 variable)
- (setq file-name (find-lisp-object-file-name variable 'defvar))
-
- (if file-name
- (progn
- (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)))
- (if valvoid
- (princ "It is void as a variable.")
- (princ "Its ")))
- (if valvoid
- (princ " is void as a variable.")
- (princ (substitute-command-keys "'s ")))))
- (unless valvoid
- (with-current-buffer standard-output
- (setq val-start-pos (point))
- (princ "value is")
- (let ((line-beg (line-beginning-position))
- (print-rep
- (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)
- (pp val)
- ;; Remove trailing newline.
- (delete-char -1))
- (let* ((sv (get variable 'standard-value))
- (origval (and (consp sv)
- (condition-case nil
- (eval (car sv))
- (error :help-eval-error))))
- from)
- (when (and (consp sv)
- (not (equal origval val))
- (not (equal origval :help-eval-error)))
- (princ "\nOriginal value was \n")
- (setq from (point))
- (pp origval)
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri)
- (when locus
- (cond
+ t
+ nil
+ nil
+ (when (symbolp v) (symbol-name v)))))
+ (list (if (equal val "") v (intern val)))))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+
+ ;; Error if no variable is specified
+ (if (not (symbolp variable))
+ (user-error "%s" "You did not specify a variable"))
+
+ (save-excursion
+ (let* ((void (not (with-current-buffer buffer (boundp variable))))
+ (val (if void nil (symbol-value variable)))
+ (locus (variable-binding-locus variable)))
+ (cl-flet ((value-pretty (lambda (val)
+ (with-temp-buffer
+ (let ((large (and (sequencep val)
+ (> (length val) 500))))
+ (if large
+ (princ val)
+ (pp val (current-buffer))
+ (when (and (not (null val))
+ (not (stringp val))
+ (sequencep val))
+ (kill-backward-chars 1))
+ (emacs-lisp-mode)
+ (turn-on-font-lock)
+ (font-lock-ensure))
+ (buffer-string))))))
+ ;; Setup xrefs
+ (help-setup-xref (list #'describe-variable variable buffer)
+ (called-interactively-p 'interactive))
+
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ ;; Variable name
+ (insert (propertize (symbol-name variable)
+ 'face font-lock-variable-name-face))
+
+ ;; Definition file
+ (if-let ((file-name (find-lisp-object-file-name variable 'defvar)))
+ (progn
+ (insert " is a variable defined in ")
+ (if (eq file-name 'C-source)
+ (insert "C source code.")
+ (help-insert-xref-button (file-name-nondirectory file-name)
+ 'help-variable-def variable file-name)
+ (insert "."))))
+ (insert "\n\n")
+
+ ;; Value
+ (if void
+ (insert "It is void as a variable.")
+ (if (and (or (null val)
+ (stringp val)
+ (not (sequencep val)))
+ (< (length (prin1-to-string val))
+ (- fill-column 13)))
+ (insert (format-message "Its value is %s.\n" (value-pretty val)))
+ (insert (format-message "Its value is:\n\n%s\n" (value-pretty val))))
+
+ ;; Original value
+ (let* ((sv (get variable 'standard-value))
+ (origval (and (consp sv)
+ (condition-case nil
+ (eval (car sv))
+ (error :help-eval-error)))))
+ (when (and (consp sv)
+ (not (equal origval val))
+ (not (equal origval :help-eval-error)))
+ (if (< (length (prin1-to-string origval))
+ (- fill-column 19))
+ (insert (format "Original value was %s.\n" (value-pretty origval)))
+ (insert (format "Original value was: \n\n%s" (value-pretty origval)))))))
+ (insert "\n")
+
+ ;; Locus (where variable's binding comes from)
+ (when locus
+ (cond
((bufferp locus)
- (princ (format "Local in buffer %s; "
- (buffer-name buffer))))
+ (insert (format "It is local to buffer %s; "
+ (buffer-name locus))))
((framep locus)
- (princ (format "It is a frame-local variable; ")))
+ (insert (format "It is local to frame %s; "
+ (print1-to-string locus))))
((terminal-live-p locus)
- (princ (format "It is a terminal-local variable; ")))
+ (insert (format "It is local to terminal %s; "
+ (prin1-to-string locus))))
(t
- (princ (format "It is local to %S" locus))))
- (if (not (default-boundp variable))
- (princ "globally void")
- (let ((global-val (default-value variable)))
- (with-current-buffer standard-output
- (princ "global value is ")
- (if (eq val global-val)
- (princ "the same.")
- (terpri)
- ;; Fixme: pp can take an age if you happen to
- ;; ask for a very large expression. We should
- ;; probably print it raw once and check it's a
- ;; sensible size before prettyprinting. -- fx
- (let ((from (point)))
- (pp global-val)
- ;; See previous comment for this function.
- ;; (help-xref-on-pp from (point))
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri))
-
- ;; If the value is large, move it to the end.
- (with-current-buffer standard-output
- (when (> (count-lines (point-min) (point-max)) 10)
- ;; Note that setting the syntax table like below
- ;; makes forward-sexp move over a `'s' at the end
- ;; of a symbol.
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (goto-char val-start-pos)
- ;; The line below previously read as
- ;; (delete-region (point) (progn (end-of-line) (point)))
- ;; which suppressed display of the buffer local value for
- ;; large values.
- (when (looking-at "value is") (replace-match ""))
- (save-excursion
- (insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
- (insert "value is shown ")
- (insert-button "below"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show value")
- (insert ".\n")))
- (terpri)
-
- (let* ((alias (condition-case nil
- (indirect-variable variable)
- (error variable)))
- (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))
-
- ;; Mention if it's a local variable.
- (cond
- ((and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (setq extra-line t)
- (princ " Automatically becomes ")
- (if permanent-local
- (princ "permanently "))
- (princ "buffer-local when set.\n"))
- ((not permanent-local))
- ((bufferp locus)
- (setq extra-line t)
- (princ
- (substitute-command-keys
- " This variable's buffer-local value is permanent.\n")))
- (t
- (setq extra-line t)
- (princ (substitute-command-keys
- " This variable's value is permanent \
-if it is given a local binding.\n"))))
-
- ;; Mention if it's an alias.
+ (insert (format "It is local to %s" locus))))
+ (if (not (default-boundp variable))
+ (insert "globally void")
+ (let ((global-val (default-value variable)))
+ (with-current-buffer standard-output
+ (insert "global value is ")
+ (if (eq val global-val)
+ (insert "the same.")
+ (insert "\n")
+ ;; Fixme: pp can take an age if you happen to
+ ;; ask for a very large expression. We should
+ ;; probably print it raw once and check it's a
+ ;; sensible size before prettyprinting. -- fx
+ (let ((from (point)))
+ (pp global-val)
+ ;; See previous comment for this function.
+ ;; (help-xref-on-pp from (point))
+ (if (< (point) (+ from 20))
+ (delete-region (1- from) from))))))))
+
+ ;; Buffer local
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (insert "Automatically becomes ")
+ (if (get variable 'permanent-local)
+ (insert "permanently "))
+ (insert "buffer-local when set.\n\n"))
+ ((not (get variable 'permanent-local)))
+ ((bufferp locus)
+ (insert
+ (substitute-command-keys
+ "This variable's buffer-local value is permanent.\n\n")))
+ (t
+ (insert "This variable's value is permanent if it is given a local binding.\n\n")))
+
+ ;; Alias
+ (let ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable))))
(unless (eq alias variable)
- (setq extra-line t)
- (princ (format-message
- " This variable is an alias for `%s'.\n"
- alias)))
-
- (when obsolete
- (setq extra-line t)
- (princ " This variable is obsolete")
- (if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))
-
- (when (member (cons variable val)
- (with-current-buffer buffer
- file-local-variables-alist))
- (setq extra-line t)
- (if (member (cons variable val)
- (with-current-buffer buffer
- dir-local-variables-alist))
- (let ((file (and (buffer-file-name buffer)
- (not (file-remote-p
- (buffer-file-name buffer)))
- (dir-locals-find-file
- (buffer-file-name buffer))))
- (is-directory nil))
- (princ (substitute-command-keys
- " This variable's value is directory-local"))
- (when (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- ;; (car file) is a directory.
- (setq file (dir-locals--all-files (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- is-directory t)))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((and (consp file) (cdr file))
- (setq file (file-name-directory (car file)))
- (format "by one of the\n %s files in the directory\n `"
- dir-locals-file))
- (t (setq file (car file))
- "by the file\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 (substitute-command-keys
- " This variable's value is file-local.\n"))))
-
- (when (memq variable ignored-local-variables)
- (setq extra-line t)
- (princ " This variable is ignored as a file-local \
-variable.\n"))
-
- ;; Can be both risky and safe, eg auto-fill-function.
- (when (risky-local-variable-p variable)
- (setq extra-line t)
- (princ " This variable may be risky if used as a \
-file-local variable.\n")
- (when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
- " However, you have added it to \
-`safe-local-variable-values'.\n"))))
-
- (when safe-var
- (setq extra-line t)
- (princ " This variable is safe as a file local variable ")
- (princ "if its value\n satisfies the predicate ")
- (princ (if (byte-code-function-p safe-var)
- "which is a byte-compiled expression.\n"
- (format-message "`%s'.\n" safe-var))))
-
- (if extra-line (terpri))
- (princ "Documentation:\n")
- (with-current-buffer standard-output
- (insert (or doc "Not documented as a variable."))))
-
- ;; Make a link to customize if this variable can be customized.
- (when (custom-variable-p variable)
- (let ((customize-label "customize"))
- (terpri)
- (terpri)
- (princ (concat "You can " customize-label " this variable."))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-variable variable))))
- ;; Note variable's version or package version.
- (let ((output (describe-variable-custom-version-info variable)))
- (when output
- (terpri)
- (terpri)
- (princ output))))
-
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string))))))))
-
+ (insert (format-message
+ "This variable is an alias for `%s'.\n\n" alias))))
+
+ ;; Obsolete
+ (let* ((obsolete (get variable 'byte-obsolete-variable))
+ (obsolete-since (nth 2 obsolete))
+ (use (car obsolete)))
+ (when obsolete-since
+ (insert (propertize (format-message "This variable is obsolete since %s" obsolete-since)
+ 'face 'error))
+ (insert (propertize (cond ((stringp use) (concat "; " use "\n"))
+ (use (format-message "; use `%s' instead.\n"
+ (car obsolete)))
+ (t ".\n"))
+ 'face 'error))
+ (insert "\n")))
+
+ ;; File or directory local
+ (when (member (cons variable val)
+ (with-current-buffer buffer
+ file-local-variables-alist))
+ (setq extra-line t)
+ (if (member (cons variable val)
+ (with-current-buffer buffer
+ dir-local-variables-alist))
+ (let ((file (and (buffer-file-name buffer)
+ (not (file-remote-p
+ (buffer-file-name buffer)))
+ (dir-locals-find-file
+ (buffer-file-name buffer))))
+ (is-directory nil))
+ (insert "This variable's value is directory-local")
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (insert ".\n")
+ (insert ", set ")
+ (insert (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
+ (help-insert-xref-button file 'help-dir-local-var-def
+ variable file)
+ (insert (substitute-command-keys "'.\n"))))
+ (insert "This variable's value is file-local.\n")))
+
+ ;; Ignored local
+ (when (memq variable ignored-local-variables)
+ (insert "This variable is ignored as a file-local variable.\n\n"))
+
+ ;; Risky local
+ (when (risky-local-variable-p variable)
+ (insert (propertize "This variable may be risky if used as a file-local variable"
+ 'face font-lock-warning-face))
+ (if (assq variable safe-local-variable-values)
+ (insert "; however, you have added it to `safe-local-variable-values'.\n"))
+ (insert ".\n\n"))
+
+ ;; Safe local
+ (when-let ((safe-var (get variable 'safe-local-variable)))
+ (insert "This variable is safe as a file local variable ")
+ (insert "if its value satisfies the predicate ")
+ (insert (if (byte-code-function-p safe-var)
+ "which is a byte-compiled expression.\n\n"
+ (format-message "`%s'.\n\n" safe-var))))
+
+ ;; Documentation
+ (unless void
+ (let* ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable)))
+ (doc (or (documentation-property variable
+ 'variable-documentation)
+ (documentation-property alias
+ 'variable-documentation)
+ "Not documented as a variable.")))
+ (insert "Documentation:\n\n")
+ (insert (propertize doc 'face font-lock-doc-face))
+ (insert "\n\n")))
+
+ ;; Make a link to customize if this variable can be
+ ;; customized.
+ (when (custom-variable-p variable)
+ (insert "You can ")
+ (help-insert-xref-button "customize" 'help-customize-variable
+ variable)
+ (insert " this variable.")
+ ;; Note variable's version or package version.
+ (when-let ((output (describe-variable-custom-version-info variable)))
+ (insert "\n\n")
+ (insert output)))
+
+ ;; Return the Help buffer string
+ (buffer-string)))))))
(defvar help-xref-stack-item)
@@ -1079,17 +1035,17 @@ describe-symbol
(found (or found v-or-f))
(enable-recursive-minibuffers t)
(val (completing-read (if found
- (format
+ (format
"Describe symbol (default %s): " v-or-f)
- "Describe symbol: ")
- obarray
- (lambda (vv)
+ "Describe symbol: ")
+ obarray
+ (lambda (vv)
(cl-some (lambda (x) (funcall (nth 1 x) vv))
describe-symbol-backends))
- t nil nil
- (if found (symbol-name v-or-f)))))
+ t nil nil
+ (if found (symbol-name v-or-f)))))
(list (if (equal val "")
- v-or-f (intern val)))))
+ v-or-f (intern val)))))
(if (not (symbolp symbol))
(user-error "You didn't specify a function or variable"))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
@@ -1139,22 +1095,22 @@ describe-syntax
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-syntax buffer)
- (called-interactively-p 'interactive))
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(let ((table (with-current-buffer buffer (syntax-table))))
(with-current-buffer standard-output
- (describe-vector table 'internal-describe-syntax-value)
- (while (setq table (char-table-parent table))
- (insert "\nThe parent syntax table is:")
- (describe-vector table 'internal-describe-syntax-value))))))
+ (describe-vector table 'internal-describe-syntax-value)
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent syntax table is:")
+ (describe-vector table 'internal-describe-syntax-value))))))
(defun help-describe-category-set (value)
(insert (cond
- ((null value) "default")
- ((char-table-p value) "deeper char-table ...")
- (t (condition-case nil
- (category-set-mnemonics value)
- (error "invalid"))))))
+ ((null value) "default")
+ ((char-table-p value) "deeper char-table ...")
+ (t (condition-case nil
+ (category-set-mnemonics value)
+ (error "invalid"))))))
;;;###autoload
(defun describe-categories (&optional buffer)
@@ -1165,57 +1121,57 @@ describe-categories
(interactive)
(setq buffer (or buffer (current-buffer)))
(help-setup-xref (list #'describe-categories buffer)
- (called-interactively-p 'interactive))
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(let* ((table (with-current-buffer buffer (category-table)))
- (docs (char-table-extra-slot table 0)))
+ (docs (char-table-extra-slot table 0)))
(if (or (not (vectorp docs)) (/= (length docs) 95))
- (error "Invalid first extra slot in this category table\n"))
+ (error "Invalid first extra slot in this category table\n"))
(with-current-buffer standard-output
(setq-default help-button-cache (make-marker))
- (insert "Legend of category mnemonics ")
+ (insert "Legend of category mnemonics ")
(insert-button "(longer descriptions at the bottom)"
'action help-button-cache
'follow-link t
'help-echo "mouse-2, RET: show full legend")
(insert "\n")
- (let ((pos (point)) (items 0) lines n)
- (dotimes (i 95)
- (if (aref docs i) (setq items (1+ items))))
- (setq lines (1+ (/ (1- items) 4)))
- (setq n 0)
- (dotimes (i 95)
- (let ((elt (aref docs i)))
- (when elt
- (string-match ".*" elt)
- (setq elt (match-string 0 elt))
- (if (>= (length elt) 17)
- (setq elt (concat (substring elt 0 14) "...")))
- (if (< (point) (point-max))
- (move-to-column (* 20 (/ n lines)) t))
- (insert (+ i ?\s) ?: elt)
- (if (< (point) (point-max))
- (forward-line 1)
- (insert "\n"))
- (setq n (1+ n))
- (if (= (% n lines) 0)
- (goto-char pos))))))
- (goto-char (point-max))
- (insert "\n"
- "character(s)\tcategory mnemonics\n"
- "------------\t------------------")
- (describe-vector table 'help-describe-category-set)
+ (let ((pos (point)) (items 0) lines n)
+ (dotimes (i 95)
+ (if (aref docs i) (setq items (1+ items))))
+ (setq lines (1+ (/ (1- items) 4)))
+ (setq n 0)
+ (dotimes (i 95)
+ (let ((elt (aref docs i)))
+ (when elt
+ (string-match ".*" elt)
+ (setq elt (match-string 0 elt))
+ (if (>= (length elt) 17)
+ (setq elt (concat (substring elt 0 14) "...")))
+ (if (< (point) (point-max))
+ (move-to-column (* 20 (/ n lines)) t))
+ (insert (+ i ?\s) ?: elt)
+ (if (< (point) (point-max))
+ (forward-line 1)
+ (insert "\n"))
+ (setq n (1+ n))
+ (if (= (% n lines) 0)
+ (goto-char pos))))))
+ (goto-char (point-max))
+ (insert "\n"
+ "character(s)\tcategory mnemonics\n"
+ "------------\t------------------")
+ (describe-vector table 'help-describe-category-set)
(set-marker help-button-cache (point))
- (insert "Legend of category mnemonics:\n")
- (dotimes (i 95)
- (let ((elt (aref docs i)))
- (when elt
- (if (string-match "\n" elt)
- (setq elt (substring elt (match-end 0))))
- (insert (+ i ?\s) ": " elt "\n"))))
- (while (setq table (char-table-parent table))
- (insert "\nThe parent category table is:")
- (describe-vector table 'help-describe-category-set))))))
+ (insert "Legend of category mnemonics:\n")
+ (dotimes (i 95)
+ (let ((elt (aref docs i)))
+ (when elt
+ (if (string-match "\n" elt)
+ (setq elt (substring elt (match-end 0))))
+ (insert (+ i ?\s) ": " elt "\n"))))
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent category table is:")
+ (describe-vector table 'help-describe-category-set))))))
\f
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
--
2.7.4
^ permalink raw reply related [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
@ 2016-09-25 18:25 Tianxiang Xiong
0 siblings, 0 replies; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-25 18:25 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 168 bytes --]
I've attached a new patch without the whitespace differences (although,
as a side note, I think it's good practice to add `whitespace-cleanup`
to `before-save-hook`).
[-- Attachment #2: 0002-Use-font-lock-for-describe-variable.patch --]
[-- Type: text/x-patch, Size: 27486 bytes --]
From 8dfffc1c7661c27c27ec01782b91b51410f313fa Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
Date: Sat, 24 Sep 2016 19:57:21 -0700
Subject: [PATCH] Use font-lock for `describe-variable`
As a side effect, clean up code.
---
lisp/help-fns.el | 570 +++++++++++++++++++++++++------------------------------
1 file changed, 263 insertions(+), 307 deletions(-)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e4e2333..768a288 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -35,6 +35,7 @@
(require 'cl-lib)
(require 'help-mode)
(require 'radix-tree)
+(require 'subr-x)
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
@@ -733,334 +734,289 @@ describe-variable-custom-version-info
(cpv (get variable 'custom-package-version))
(output nil))
(if custom-version
- (setq output
- (format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
- custom-version))
+ (setq output
+ (format "This variable was introduced, or its default value was changed, in version %s of Emacs.\n"
+ custom-version))
(when cpv
- (let* ((package (car-safe cpv))
- (version (if (listp (cdr-safe cpv))
- (car (cdr-safe cpv))
- (cdr-safe cpv)))
- (pkg-versions (assq package customize-package-emacs-version-alist))
- (emacsv (cdr (assoc version pkg-versions))))
- (if (and package version)
- (setq output
- (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
- (if emacsv
- (format " that is part of Emacs %s" emacsv))
- ".\n")
- version package))))))
+ (let* ((package (car-safe cpv))
+ (version (if (listp (cdr-safe cpv))
+ (car (cdr-safe cpv))
+ (cdr-safe cpv)))
+ (pkg-versions (assq package customize-package-emacs-version-alist))
+ (emacsv (cdr (assoc version pkg-versions))))
+ (if (and package version)
+ (setq output
+ (format (concat "This variable was introduced, or its default value was changed, in version %s of the %s package"
+ (if emacsv
+ (format " that is part of Emacs %s" emacsv))
+ ".\n")
+ version package))))))
output))
;;;###autoload
(defun describe-variable (variable &optional buffer frame)
"Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also.
-If VARIABLE 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."
+
+Returns the documentation as a string.
+
+If VARIABLE has a buffer-local value in BUFFER or FRAME (default
+to the current buffer and frame), it is displayed along
+with the global value."
(interactive
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- (orig-buffer (current-buffer))
- val)
- (setq val (completing-read
+ (let* ((v (variable-at-point))
+ (enable-recursive-minibuffers t)
+ (orig-buffer (current-buffer))
+ (val (completing-read
(if (symbolp v)
(format
"Describe variable (default %s): " v)
"Describe variable: ")
#'help--symbol-completion-table
(lambda (vv)
- ;; In case the variable only exists in the buffer
- ;; the command we switch back to that buffer before
- ;; we examine the variable.
(with-current-buffer orig-buffer
(or (get vv 'variable-documentation)
(and (boundp vv) (not (keywordp vv))))))
- t nil nil
- (if (symbolp v) (symbol-name v))))
- (list (if (equal val "")
- v (intern val)))))
- (let (file-name)
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (if (not (symbolp variable))
- (message "You did not specify a variable")
- (save-excursion
- (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- (permanent-local (get variable 'permanent-local))
- val val-start-pos locus)
- ;; Extract the value before setting up the output buffer,
- ;; in case `buffer' *is* the output buffer.
- (unless valvoid
- (with-selected-frame frame
- (with-current-buffer buffer
- (setq val (symbol-value variable)
- locus (variable-binding-locus variable)))))
- (help-setup-xref (list #'describe-variable variable buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (prin1 variable)
- (setq file-name (find-lisp-object-file-name variable 'defvar))
-
- (if file-name
- (progn
- (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)))
- (if valvoid
- (princ "It is void as a variable.")
- (princ "Its ")))
- (if valvoid
- (princ " is void as a variable.")
- (princ (substitute-command-keys "'s ")))))
- (unless valvoid
- (with-current-buffer standard-output
- (setq val-start-pos (point))
- (princ "value is")
- (let ((line-beg (line-beginning-position))
- (print-rep
- (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)
- (pp val)
- ;; Remove trailing newline.
- (delete-char -1))
- (let* ((sv (get variable 'standard-value))
- (origval (and (consp sv)
- (condition-case nil
- (eval (car sv))
- (error :help-eval-error))))
- from)
- (when (and (consp sv)
- (not (equal origval val))
- (not (equal origval :help-eval-error)))
- (princ "\nOriginal value was \n")
- (setq from (point))
- (pp origval)
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri)
- (when locus
- (cond
+ t
+ nil
+ nil
+ (when (symbolp v) (symbol-name v)))))
+ (list (if (equal val "") v (intern val)))))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+
+ ;; Error if no variable is specified
+ (if (not (symbolp variable))
+ (user-error "%s" "You did not specify a variable"))
+
+ (save-excursion
+ (let* ((void (not (with-current-buffer buffer (boundp variable))))
+ (val (if void nil (symbol-value variable)))
+ (locus (variable-binding-locus variable)))
+ (cl-flet ((value-pretty (lambda (val)
+ (with-temp-buffer
+ (let ((large (and (sequencep val)
+ (> (length val) 500))))
+ (if large
+ (princ val)
+ (pp val (current-buffer))
+ (when (and (not (null val))
+ (not (stringp val))
+ (sequencep val))
+ (kill-backward-chars 1))
+ (emacs-lisp-mode)
+ (turn-on-font-lock)
+ (font-lock-ensure))
+ (buffer-string))))))
+ ;; Setup xrefs
+ (help-setup-xref (list #'describe-variable variable buffer)
+ (called-interactively-p 'interactive))
+
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ ;; Variable name
+ (insert (propertize (symbol-name variable)
+ 'face font-lock-variable-name-face))
+
+ ;; Definition file
+ (if-let ((file-name (find-lisp-object-file-name variable 'defvar)))
+ (progn
+ (insert " is a variable defined in ")
+ (if (eq file-name 'C-source)
+ (insert "C source code.")
+ (help-insert-xref-button (file-name-nondirectory file-name)
+ 'help-variable-def variable file-name)
+ (insert "."))))
+ (insert "\n\n")
+
+ ;; Value
+ (if void
+ (insert "It is void as a variable.")
+ (if (and (or (null val)
+ (stringp val)
+ (not (sequencep val)))
+ (< (length (prin1-to-string val))
+ (- fill-column 13)))
+ (insert (format-message "Its value is %s.\n" (value-pretty val)))
+ (insert (format-message "Its value is:\n\n%s\n" (value-pretty val))))
+
+ ;; Original value
+ (let* ((sv (get variable 'standard-value))
+ (origval (and (consp sv)
+ (condition-case nil
+ (eval (car sv))
+ (error :help-eval-error)))))
+ (when (and (consp sv)
+ (not (equal origval val))
+ (not (equal origval :help-eval-error)))
+ (if (< (length (prin1-to-string origval))
+ (- fill-column 19))
+ (insert (format "Original value was %s.\n" (value-pretty origval)))
+ (insert (format "Original value was: \n\n%s" (value-pretty origval)))))))
+ (insert "\n")
+
+ ;; Locus (where variable's binding comes from)
+ (when locus
+ (cond
((bufferp locus)
- (princ (format "Local in buffer %s; "
- (buffer-name buffer))))
+ (insert (format "It is local to buffer %s; "
+ (buffer-name locus))))
((framep locus)
- (princ (format "It is a frame-local variable; ")))
+ (insert (format "It is local to frame %s; "
+ (print1-to-string locus))))
((terminal-live-p locus)
- (princ (format "It is a terminal-local variable; ")))
+ (insert (format "It is local to terminal %s; "
+ (prin1-to-string locus))))
(t
- (princ (format "It is local to %S" locus))))
- (if (not (default-boundp variable))
- (princ "globally void")
- (let ((global-val (default-value variable)))
- (with-current-buffer standard-output
- (princ "global value is ")
- (if (eq val global-val)
- (princ "the same.")
- (terpri)
- ;; Fixme: pp can take an age if you happen to
- ;; ask for a very large expression. We should
- ;; probably print it raw once and check it's a
- ;; sensible size before prettyprinting. -- fx
- (let ((from (point)))
- (pp global-val)
- ;; See previous comment for this function.
- ;; (help-xref-on-pp from (point))
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri))
-
- ;; If the value is large, move it to the end.
- (with-current-buffer standard-output
- (when (> (count-lines (point-min) (point-max)) 10)
- ;; Note that setting the syntax table like below
- ;; makes forward-sexp move over a `'s' at the end
- ;; of a symbol.
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (goto-char val-start-pos)
- ;; The line below previously read as
- ;; (delete-region (point) (progn (end-of-line) (point)))
- ;; which suppressed display of the buffer local value for
- ;; large values.
- (when (looking-at "value is") (replace-match ""))
- (save-excursion
- (insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
- (insert "value is shown ")
- (insert-button "below"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show value")
- (insert ".\n")))
- (terpri)
-
- (let* ((alias (condition-case nil
- (indirect-variable variable)
- (error variable)))
- (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))
-
- ;; Mention if it's a local variable.
- (cond
- ((and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (setq extra-line t)
- (princ " Automatically becomes ")
- (if permanent-local
- (princ "permanently "))
- (princ "buffer-local when set.\n"))
- ((not permanent-local))
- ((bufferp locus)
- (setq extra-line t)
- (princ
- (substitute-command-keys
- " This variable's buffer-local value is permanent.\n")))
- (t
- (setq extra-line t)
- (princ (substitute-command-keys
- " This variable's value is permanent \
-if it is given a local binding.\n"))))
-
- ;; Mention if it's an alias.
+ (insert (format "It is local to %s" locus))))
+ (if (not (default-boundp variable))
+ (insert "globally void")
+ (let ((global-val (default-value variable)))
+ (with-current-buffer standard-output
+ (insert "global value is ")
+ (if (eq val global-val)
+ (insert "the same.")
+ (insert "\n")
+ ;; Fixme: pp can take an age if you happen to
+ ;; ask for a very large expression. We should
+ ;; probably print it raw once and check it's a
+ ;; sensible size before prettyprinting. -- fx
+ (let ((from (point)))
+ (pp global-val)
+ ;; See previous comment for this function.
+ ;; (help-xref-on-pp from (point))
+ (if (< (point) (+ from 20))
+ (delete-region (1- from) from))))))))
+
+ ;; Buffer local
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (insert "Automatically becomes ")
+ (if (get variable 'permanent-local)
+ (insert "permanently "))
+ (insert "buffer-local when set.\n\n"))
+ ((not (get variable 'permanent-local)))
+ ((bufferp locus)
+ (insert
+ (substitute-command-keys
+ "This variable's buffer-local value is permanent.\n\n")))
+ (t
+ (insert "This variable's value is permanent if it is given a local binding.\n\n")))
+
+ ;; Alias
+ (let ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable))))
(unless (eq alias variable)
- (setq extra-line t)
- (princ (format-message
- " This variable is an alias for `%s'.\n"
- alias)))
-
- (when obsolete
- (setq extra-line t)
- (princ " This variable is obsolete")
- (if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))
-
- (when (member (cons variable val)
- (with-current-buffer buffer
- file-local-variables-alist))
- (setq extra-line t)
- (if (member (cons variable val)
- (with-current-buffer buffer
- dir-local-variables-alist))
- (let ((file (and (buffer-file-name buffer)
- (not (file-remote-p
- (buffer-file-name buffer)))
- (dir-locals-find-file
- (buffer-file-name buffer))))
- (is-directory nil))
- (princ (substitute-command-keys
- " This variable's value is directory-local"))
- (when (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- ;; (car file) is a directory.
- (setq file (dir-locals--all-files (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- is-directory t)))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((and (consp file) (cdr file))
- (setq file (file-name-directory (car file)))
- (format "by one of the\n %s files in the directory\n `"
- dir-locals-file))
- (t (setq file (car file))
- "by the file\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 (substitute-command-keys
- " This variable's value is file-local.\n"))))
-
- (when (memq variable ignored-local-variables)
- (setq extra-line t)
- (princ " This variable is ignored as a file-local \
-variable.\n"))
-
- ;; Can be both risky and safe, eg auto-fill-function.
- (when (risky-local-variable-p variable)
- (setq extra-line t)
- (princ " This variable may be risky if used as a \
-file-local variable.\n")
- (when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
- " However, you have added it to \
-`safe-local-variable-values'.\n"))))
-
- (when safe-var
- (setq extra-line t)
- (princ " This variable is safe as a file local variable ")
- (princ "if its value\n satisfies the predicate ")
- (princ (if (byte-code-function-p safe-var)
- "which is a byte-compiled expression.\n"
- (format-message "`%s'.\n" safe-var))))
-
- (if extra-line (terpri))
- (princ "Documentation:\n")
- (with-current-buffer standard-output
- (insert (or doc "Not documented as a variable."))))
-
- ;; Make a link to customize if this variable can be customized.
- (when (custom-variable-p variable)
- (let ((customize-label "customize"))
- (terpri)
- (terpri)
- (princ (concat "You can " customize-label " this variable."))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-variable variable))))
- ;; Note variable's version or package version.
- (let ((output (describe-variable-custom-version-info variable)))
- (when output
- (terpri)
- (terpri)
- (princ output))))
-
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string))))))))
-
+ (insert (format-message
+ "This variable is an alias for `%s'.\n\n" alias))))
+
+ ;; Obsolete
+ (let* ((obsolete (get variable 'byte-obsolete-variable))
+ (obsolete-since (nth 2 obsolete))
+ (use (car obsolete)))
+ (when obsolete-since
+ (insert (propertize (format-message "This variable is obsolete since %s" obsolete-since)
+ 'face 'error))
+ (insert (propertize (cond ((stringp use) (concat "; " use "\n"))
+ (use (format-message "; use `%s' instead.\n"
+ (car obsolete)))
+ (t ".\n"))
+ 'face 'error))
+ (insert "\n")))
+
+ ;; File or directory local
+ (when (member (cons variable val)
+ (with-current-buffer buffer
+ file-local-variables-alist))
+ (setq extra-line t)
+ (if (member (cons variable val)
+ (with-current-buffer buffer
+ dir-local-variables-alist))
+ (let ((file (and (buffer-file-name buffer)
+ (not (file-remote-p
+ (buffer-file-name buffer)))
+ (dir-locals-find-file
+ (buffer-file-name buffer))))
+ (is-directory nil))
+ (insert "This variable's value is directory-local")
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (insert ".\n")
+ (insert ", set ")
+ (insert (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
+ (help-insert-xref-button file 'help-dir-local-var-def
+ variable file)
+ (insert (substitute-command-keys "'.\n"))))
+ (insert "This variable's value is file-local.\n")))
+
+ ;; Ignored local
+ (when (memq variable ignored-local-variables)
+ (insert "This variable is ignored as a file-local variable.\n\n"))
+
+ ;; Risky local
+ (when (risky-local-variable-p variable)
+ (insert (propertize "This variable may be risky if used as a file-local variable"
+ 'face font-lock-warning-face))
+ (if (assq variable safe-local-variable-values)
+ (insert "; however, you have added it to `safe-local-variable-values'.\n"))
+ (insert ".\n\n"))
+
+ ;; Safe local
+ (when-let ((safe-var (get variable 'safe-local-variable)))
+ (insert "This variable is safe as a file local variable")
+ (insert "if its value satisfies the predicate ")
+ (insert (if (byte-code-function-p safe-var)
+ "which is a byte-compiled expression.\n\n"
+ (format-message "`%s'.\n\n" safe-var))))
+
+ ;; Documentation
+ (unless void
+ (let* ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable)))
+ (doc (or (documentation-property variable
+ 'variable-documentation)
+ (documentation-property alias
+ 'variable-documentation)
+ "Not documented as a variable.")))
+ (insert "Documentation:\n\n")
+ (insert (propertize doc 'face font-lock-doc-face))
+ (insert "\n\n")))
+
+ ;; Make a link to customize if this variable can be
+ ;; customized.
+ (when (custom-variable-p variable)
+ (insert "You can ")
+ (help-insert-xref-button "customize" 'help-customize-variable
+ variable)
+ (insert " this variable.")
+ ;; Note variable's version or package version.
+ (when-let ((output (describe-variable-custom-version-info variable)))
+ (insert "\n\n")
+ (insert output)))
+
+ ;; Return the Help buffer string
+ (buffer-string)))))))
(defvar help-xref-stack-item)
--
2.7.4
^ permalink raw reply related [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
@ 2016-09-27 4:09 Tianxiang Xiong
2016-09-27 15:49 ` Eli Zaretskii
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-27 4:09 UTC (permalink / raw)
To: monnier, emacs-devel@gnu.org, clement.pit
Would anyone care to take a look at the revised version of the
proposal? It's in another e-mail on this thread.
There are still a few kinks, such as:
- How to properly handle large values. Right now we have a policy of
not pretty-printing if the print representation is above some arbitrary
value; should we make use of `print-length` and `print-level` to ensure
that the print representation is always "reasonable"? Or is `describe-
variable` expected to always show the whole value?
- Handling sequences that cannot be operated on with standard sequence
functions like "length", e.g. rings. This one was a surprise, but
should not be too hard to fix.
- Syntax tables. For some reason, syntax table print in front of the
"Its value is:" prompt; I've yet to figure out why.
Thanks,
TX
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-27 4:09 Tianxiang Xiong
@ 2016-09-27 15:49 ` Eli Zaretskii
2016-09-27 16:30 ` Tianxiang Xiong
0 siblings, 1 reply; 24+ messages in thread
From: Eli Zaretskii @ 2016-09-27 15:49 UTC (permalink / raw)
To: Tianxiang Xiong; +Cc: clement.pit, monnier, emacs-devel
> From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
> Date: Mon, 26 Sep 2016 21:09:38 -0700
>
> Would anyone care to take a look at the revised version of the
> proposal? It's in another e-mail on this thread.
Could you perhaps send a patch without the whitespace changes? It
looks like most of the diffs are due to whitespace, which makes it
hard to see the real changes.
Thanks.
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-27 15:49 ` Eli Zaretskii
@ 2016-09-27 16:30 ` Tianxiang Xiong
2016-09-27 17:40 ` Eli Zaretskii
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-27 16:30 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: emacs-devel, monnier, Clément Pit--Claudel
[-- Attachment #1: Type: text/plain, Size: 494 bytes --]
Even the 0002 version?
On Sep 27, 2016 8:49 AM, "Eli Zaretskii" <eliz@gnu.org> wrote:
> > From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
> > Date: Mon, 26 Sep 2016 21:09:38 -0700
> >
> > Would anyone care to take a look at the revised version of the
> > proposal? It's in another e-mail on this thread.
>
> Could you perhaps send a patch without the whitespace changes? It
> looks like most of the diffs are due to whitespace, which makes it
> hard to see the real changes.
>
> Thanks.
>
[-- Attachment #2: Type: text/html, Size: 871 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-27 16:30 ` Tianxiang Xiong
@ 2016-09-27 17:40 ` Eli Zaretskii
2016-09-28 3:45 ` Tianxiang Xiong
0 siblings, 1 reply; 24+ messages in thread
From: Eli Zaretskii @ 2016-09-27 17:40 UTC (permalink / raw)
To: Tianxiang Xiong; +Cc: clement.pit, monnier, emacs-devel
> From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
> Date: Tue, 27 Sep 2016 09:30:18 -0700
> Cc: emacs-devel@gnu.org, monnier@iro.umontreal.ca,
> Clément Pit--Claudel <clement.pit@gmail.com>
>
> Even the 0002 version?
Yes.
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-27 17:40 ` Eli Zaretskii
@ 2016-09-28 3:45 ` Tianxiang Xiong
2016-09-28 4:21 ` Clément Pit--Claudel
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-28 3:45 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Clément Pit--Claudel, monnier, emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 774 bytes --]
@Eli I don't know what you mean, then. The diffs in the 0002 version are
definitely not due to whitespace changes; I explicitly removed the
whitespace-only changes from 0001.
There *is* a good amount of refactoring, simply because the previous code
was very hard to follow. The new code is ~40 lines shorter and, if I do say
so myself, much clearer.
I've attached the 0002 version again in case there's something wrong with
the previous one.
2016-09-27 10:40 GMT-07:00 Eli Zaretskii <eliz@gnu.org>:
> > From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
> > Date: Tue, 27 Sep 2016 09:30:18 -0700
> > Cc: emacs-devel@gnu.org, monnier@iro.umontreal.ca,
> > Clément Pit--Claudel <clement.pit@gmail.com>
> >
> > Even the 0002 version?
>
> Yes.
>
[-- Attachment #1.2: Type: text/html, Size: 1347 bytes --]
[-- Attachment #2: 0002-Use-font-lock-for-describe-variable.patch --]
[-- Type: text/x-patch, Size: 27486 bytes --]
From 8dfffc1c7661c27c27ec01782b91b51410f313fa Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
Date: Sat, 24 Sep 2016 19:57:21 -0700
Subject: [PATCH] Use font-lock for `describe-variable`
As a side effect, clean up code.
---
lisp/help-fns.el | 570 +++++++++++++++++++++++++------------------------------
1 file changed, 263 insertions(+), 307 deletions(-)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e4e2333..768a288 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -35,6 +35,7 @@
(require 'cl-lib)
(require 'help-mode)
(require 'radix-tree)
+(require 'subr-x)
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
@@ -733,334 +734,289 @@ describe-variable-custom-version-info
(cpv (get variable 'custom-package-version))
(output nil))
(if custom-version
- (setq output
- (format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
- custom-version))
+ (setq output
+ (format "This variable was introduced, or its default value was changed, in version %s of Emacs.\n"
+ custom-version))
(when cpv
- (let* ((package (car-safe cpv))
- (version (if (listp (cdr-safe cpv))
- (car (cdr-safe cpv))
- (cdr-safe cpv)))
- (pkg-versions (assq package customize-package-emacs-version-alist))
- (emacsv (cdr (assoc version pkg-versions))))
- (if (and package version)
- (setq output
- (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
- (if emacsv
- (format " that is part of Emacs %s" emacsv))
- ".\n")
- version package))))))
+ (let* ((package (car-safe cpv))
+ (version (if (listp (cdr-safe cpv))
+ (car (cdr-safe cpv))
+ (cdr-safe cpv)))
+ (pkg-versions (assq package customize-package-emacs-version-alist))
+ (emacsv (cdr (assoc version pkg-versions))))
+ (if (and package version)
+ (setq output
+ (format (concat "This variable was introduced, or its default value was changed, in version %s of the %s package"
+ (if emacsv
+ (format " that is part of Emacs %s" emacsv))
+ ".\n")
+ version package))))))
output))
;;;###autoload
(defun describe-variable (variable &optional buffer frame)
"Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also.
-If VARIABLE 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."
+
+Returns the documentation as a string.
+
+If VARIABLE has a buffer-local value in BUFFER or FRAME (default
+to the current buffer and frame), it is displayed along
+with the global value."
(interactive
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- (orig-buffer (current-buffer))
- val)
- (setq val (completing-read
+ (let* ((v (variable-at-point))
+ (enable-recursive-minibuffers t)
+ (orig-buffer (current-buffer))
+ (val (completing-read
(if (symbolp v)
(format
"Describe variable (default %s): " v)
"Describe variable: ")
#'help--symbol-completion-table
(lambda (vv)
- ;; In case the variable only exists in the buffer
- ;; the command we switch back to that buffer before
- ;; we examine the variable.
(with-current-buffer orig-buffer
(or (get vv 'variable-documentation)
(and (boundp vv) (not (keywordp vv))))))
- t nil nil
- (if (symbolp v) (symbol-name v))))
- (list (if (equal val "")
- v (intern val)))))
- (let (file-name)
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (if (not (symbolp variable))
- (message "You did not specify a variable")
- (save-excursion
- (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- (permanent-local (get variable 'permanent-local))
- val val-start-pos locus)
- ;; Extract the value before setting up the output buffer,
- ;; in case `buffer' *is* the output buffer.
- (unless valvoid
- (with-selected-frame frame
- (with-current-buffer buffer
- (setq val (symbol-value variable)
- locus (variable-binding-locus variable)))))
- (help-setup-xref (list #'describe-variable variable buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (prin1 variable)
- (setq file-name (find-lisp-object-file-name variable 'defvar))
-
- (if file-name
- (progn
- (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)))
- (if valvoid
- (princ "It is void as a variable.")
- (princ "Its ")))
- (if valvoid
- (princ " is void as a variable.")
- (princ (substitute-command-keys "'s ")))))
- (unless valvoid
- (with-current-buffer standard-output
- (setq val-start-pos (point))
- (princ "value is")
- (let ((line-beg (line-beginning-position))
- (print-rep
- (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)
- (pp val)
- ;; Remove trailing newline.
- (delete-char -1))
- (let* ((sv (get variable 'standard-value))
- (origval (and (consp sv)
- (condition-case nil
- (eval (car sv))
- (error :help-eval-error))))
- from)
- (when (and (consp sv)
- (not (equal origval val))
- (not (equal origval :help-eval-error)))
- (princ "\nOriginal value was \n")
- (setq from (point))
- (pp origval)
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri)
- (when locus
- (cond
+ t
+ nil
+ nil
+ (when (symbolp v) (symbol-name v)))))
+ (list (if (equal val "") v (intern val)))))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+
+ ;; Error if no variable is specified
+ (if (not (symbolp variable))
+ (user-error "%s" "You did not specify a variable"))
+
+ (save-excursion
+ (let* ((void (not (with-current-buffer buffer (boundp variable))))
+ (val (if void nil (symbol-value variable)))
+ (locus (variable-binding-locus variable)))
+ (cl-flet ((value-pretty (lambda (val)
+ (with-temp-buffer
+ (let ((large (and (sequencep val)
+ (> (length val) 500))))
+ (if large
+ (princ val)
+ (pp val (current-buffer))
+ (when (and (not (null val))
+ (not (stringp val))
+ (sequencep val))
+ (kill-backward-chars 1))
+ (emacs-lisp-mode)
+ (turn-on-font-lock)
+ (font-lock-ensure))
+ (buffer-string))))))
+ ;; Setup xrefs
+ (help-setup-xref (list #'describe-variable variable buffer)
+ (called-interactively-p 'interactive))
+
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ ;; Variable name
+ (insert (propertize (symbol-name variable)
+ 'face font-lock-variable-name-face))
+
+ ;; Definition file
+ (if-let ((file-name (find-lisp-object-file-name variable 'defvar)))
+ (progn
+ (insert " is a variable defined in ")
+ (if (eq file-name 'C-source)
+ (insert "C source code.")
+ (help-insert-xref-button (file-name-nondirectory file-name)
+ 'help-variable-def variable file-name)
+ (insert "."))))
+ (insert "\n\n")
+
+ ;; Value
+ (if void
+ (insert "It is void as a variable.")
+ (if (and (or (null val)
+ (stringp val)
+ (not (sequencep val)))
+ (< (length (prin1-to-string val))
+ (- fill-column 13)))
+ (insert (format-message "Its value is %s.\n" (value-pretty val)))
+ (insert (format-message "Its value is:\n\n%s\n" (value-pretty val))))
+
+ ;; Original value
+ (let* ((sv (get variable 'standard-value))
+ (origval (and (consp sv)
+ (condition-case nil
+ (eval (car sv))
+ (error :help-eval-error)))))
+ (when (and (consp sv)
+ (not (equal origval val))
+ (not (equal origval :help-eval-error)))
+ (if (< (length (prin1-to-string origval))
+ (- fill-column 19))
+ (insert (format "Original value was %s.\n" (value-pretty origval)))
+ (insert (format "Original value was: \n\n%s" (value-pretty origval)))))))
+ (insert "\n")
+
+ ;; Locus (where variable's binding comes from)
+ (when locus
+ (cond
((bufferp locus)
- (princ (format "Local in buffer %s; "
- (buffer-name buffer))))
+ (insert (format "It is local to buffer %s; "
+ (buffer-name locus))))
((framep locus)
- (princ (format "It is a frame-local variable; ")))
+ (insert (format "It is local to frame %s; "
+ (print1-to-string locus))))
((terminal-live-p locus)
- (princ (format "It is a terminal-local variable; ")))
+ (insert (format "It is local to terminal %s; "
+ (prin1-to-string locus))))
(t
- (princ (format "It is local to %S" locus))))
- (if (not (default-boundp variable))
- (princ "globally void")
- (let ((global-val (default-value variable)))
- (with-current-buffer standard-output
- (princ "global value is ")
- (if (eq val global-val)
- (princ "the same.")
- (terpri)
- ;; Fixme: pp can take an age if you happen to
- ;; ask for a very large expression. We should
- ;; probably print it raw once and check it's a
- ;; sensible size before prettyprinting. -- fx
- (let ((from (point)))
- (pp global-val)
- ;; See previous comment for this function.
- ;; (help-xref-on-pp from (point))
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri))
-
- ;; If the value is large, move it to the end.
- (with-current-buffer standard-output
- (when (> (count-lines (point-min) (point-max)) 10)
- ;; Note that setting the syntax table like below
- ;; makes forward-sexp move over a `'s' at the end
- ;; of a symbol.
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (goto-char val-start-pos)
- ;; The line below previously read as
- ;; (delete-region (point) (progn (end-of-line) (point)))
- ;; which suppressed display of the buffer local value for
- ;; large values.
- (when (looking-at "value is") (replace-match ""))
- (save-excursion
- (insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
- (insert "value is shown ")
- (insert-button "below"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show value")
- (insert ".\n")))
- (terpri)
-
- (let* ((alias (condition-case nil
- (indirect-variable variable)
- (error variable)))
- (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))
-
- ;; Mention if it's a local variable.
- (cond
- ((and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (setq extra-line t)
- (princ " Automatically becomes ")
- (if permanent-local
- (princ "permanently "))
- (princ "buffer-local when set.\n"))
- ((not permanent-local))
- ((bufferp locus)
- (setq extra-line t)
- (princ
- (substitute-command-keys
- " This variable's buffer-local value is permanent.\n")))
- (t
- (setq extra-line t)
- (princ (substitute-command-keys
- " This variable's value is permanent \
-if it is given a local binding.\n"))))
-
- ;; Mention if it's an alias.
+ (insert (format "It is local to %s" locus))))
+ (if (not (default-boundp variable))
+ (insert "globally void")
+ (let ((global-val (default-value variable)))
+ (with-current-buffer standard-output
+ (insert "global value is ")
+ (if (eq val global-val)
+ (insert "the same.")
+ (insert "\n")
+ ;; Fixme: pp can take an age if you happen to
+ ;; ask for a very large expression. We should
+ ;; probably print it raw once and check it's a
+ ;; sensible size before prettyprinting. -- fx
+ (let ((from (point)))
+ (pp global-val)
+ ;; See previous comment for this function.
+ ;; (help-xref-on-pp from (point))
+ (if (< (point) (+ from 20))
+ (delete-region (1- from) from))))))))
+
+ ;; Buffer local
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (insert "Automatically becomes ")
+ (if (get variable 'permanent-local)
+ (insert "permanently "))
+ (insert "buffer-local when set.\n\n"))
+ ((not (get variable 'permanent-local)))
+ ((bufferp locus)
+ (insert
+ (substitute-command-keys
+ "This variable's buffer-local value is permanent.\n\n")))
+ (t
+ (insert "This variable's value is permanent if it is given a local binding.\n\n")))
+
+ ;; Alias
+ (let ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable))))
(unless (eq alias variable)
- (setq extra-line t)
- (princ (format-message
- " This variable is an alias for `%s'.\n"
- alias)))
-
- (when obsolete
- (setq extra-line t)
- (princ " This variable is obsolete")
- (if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))
-
- (when (member (cons variable val)
- (with-current-buffer buffer
- file-local-variables-alist))
- (setq extra-line t)
- (if (member (cons variable val)
- (with-current-buffer buffer
- dir-local-variables-alist))
- (let ((file (and (buffer-file-name buffer)
- (not (file-remote-p
- (buffer-file-name buffer)))
- (dir-locals-find-file
- (buffer-file-name buffer))))
- (is-directory nil))
- (princ (substitute-command-keys
- " This variable's value is directory-local"))
- (when (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- ;; (car file) is a directory.
- (setq file (dir-locals--all-files (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- is-directory t)))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((and (consp file) (cdr file))
- (setq file (file-name-directory (car file)))
- (format "by one of the\n %s files in the directory\n `"
- dir-locals-file))
- (t (setq file (car file))
- "by the file\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 (substitute-command-keys
- " This variable's value is file-local.\n"))))
-
- (when (memq variable ignored-local-variables)
- (setq extra-line t)
- (princ " This variable is ignored as a file-local \
-variable.\n"))
-
- ;; Can be both risky and safe, eg auto-fill-function.
- (when (risky-local-variable-p variable)
- (setq extra-line t)
- (princ " This variable may be risky if used as a \
-file-local variable.\n")
- (when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
- " However, you have added it to \
-`safe-local-variable-values'.\n"))))
-
- (when safe-var
- (setq extra-line t)
- (princ " This variable is safe as a file local variable ")
- (princ "if its value\n satisfies the predicate ")
- (princ (if (byte-code-function-p safe-var)
- "which is a byte-compiled expression.\n"
- (format-message "`%s'.\n" safe-var))))
-
- (if extra-line (terpri))
- (princ "Documentation:\n")
- (with-current-buffer standard-output
- (insert (or doc "Not documented as a variable."))))
-
- ;; Make a link to customize if this variable can be customized.
- (when (custom-variable-p variable)
- (let ((customize-label "customize"))
- (terpri)
- (terpri)
- (princ (concat "You can " customize-label " this variable."))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-variable variable))))
- ;; Note variable's version or package version.
- (let ((output (describe-variable-custom-version-info variable)))
- (when output
- (terpri)
- (terpri)
- (princ output))))
-
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string))))))))
-
+ (insert (format-message
+ "This variable is an alias for `%s'.\n\n" alias))))
+
+ ;; Obsolete
+ (let* ((obsolete (get variable 'byte-obsolete-variable))
+ (obsolete-since (nth 2 obsolete))
+ (use (car obsolete)))
+ (when obsolete-since
+ (insert (propertize (format-message "This variable is obsolete since %s" obsolete-since)
+ 'face 'error))
+ (insert (propertize (cond ((stringp use) (concat "; " use "\n"))
+ (use (format-message "; use `%s' instead.\n"
+ (car obsolete)))
+ (t ".\n"))
+ 'face 'error))
+ (insert "\n")))
+
+ ;; File or directory local
+ (when (member (cons variable val)
+ (with-current-buffer buffer
+ file-local-variables-alist))
+ (setq extra-line t)
+ (if (member (cons variable val)
+ (with-current-buffer buffer
+ dir-local-variables-alist))
+ (let ((file (and (buffer-file-name buffer)
+ (not (file-remote-p
+ (buffer-file-name buffer)))
+ (dir-locals-find-file
+ (buffer-file-name buffer))))
+ (is-directory nil))
+ (insert "This variable's value is directory-local")
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (insert ".\n")
+ (insert ", set ")
+ (insert (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
+ (help-insert-xref-button file 'help-dir-local-var-def
+ variable file)
+ (insert (substitute-command-keys "'.\n"))))
+ (insert "This variable's value is file-local.\n")))
+
+ ;; Ignored local
+ (when (memq variable ignored-local-variables)
+ (insert "This variable is ignored as a file-local variable.\n\n"))
+
+ ;; Risky local
+ (when (risky-local-variable-p variable)
+ (insert (propertize "This variable may be risky if used as a file-local variable"
+ 'face font-lock-warning-face))
+ (if (assq variable safe-local-variable-values)
+ (insert "; however, you have added it to `safe-local-variable-values'.\n"))
+ (insert ".\n\n"))
+
+ ;; Safe local
+ (when-let ((safe-var (get variable 'safe-local-variable)))
+ (insert "This variable is safe as a file local variable")
+ (insert "if its value satisfies the predicate ")
+ (insert (if (byte-code-function-p safe-var)
+ "which is a byte-compiled expression.\n\n"
+ (format-message "`%s'.\n\n" safe-var))))
+
+ ;; Documentation
+ (unless void
+ (let* ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable)))
+ (doc (or (documentation-property variable
+ 'variable-documentation)
+ (documentation-property alias
+ 'variable-documentation)
+ "Not documented as a variable.")))
+ (insert "Documentation:\n\n")
+ (insert (propertize doc 'face font-lock-doc-face))
+ (insert "\n\n")))
+
+ ;; Make a link to customize if this variable can be
+ ;; customized.
+ (when (custom-variable-p variable)
+ (insert "You can ")
+ (help-insert-xref-button "customize" 'help-customize-variable
+ variable)
+ (insert " this variable.")
+ ;; Note variable's version or package version.
+ (when-let ((output (describe-variable-custom-version-info variable)))
+ (insert "\n\n")
+ (insert output)))
+
+ ;; Return the Help buffer string
+ (buffer-string)))))))
(defvar help-xref-stack-item)
--
2.7.4
^ permalink raw reply related [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
2016-09-28 3:45 ` Tianxiang Xiong
@ 2016-09-28 4:21 ` Clément Pit--Claudel
2016-09-30 7:34 ` Tianxiang Xiong
0 siblings, 1 reply; 24+ messages in thread
From: Clément Pit--Claudel @ 2016-09-28 4:21 UTC (permalink / raw)
To: Tianxiang Xiong, Eli Zaretskii; +Cc: monnier, emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 1559 bytes --]
I think Eli is pointing out that in every place where you made a modification to the code, you also changed the whitespace. For example, you untabified all three lines of the following chunk.
- (setq output
- (format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
- custom-version))
+ (setq output
+ (format "This variable was introduced, or its default value was changed, in version %s of Emacs.\n"
+ custom-version))
Clément.
On 2016-09-27 23:45, Tianxiang Xiong wrote:
> @Eli I don't know what you mean, then. The diffs in the 0002 version are definitely not due to whitespace changes; I explicitly removed the whitespace-only changes from 0001.
>
> There /is/ a good amount of refactoring, simply because the previous code was very hard to follow. The new code is ~40 lines shorter and, if I do say so myself, much clearer.
>
> I've attached the 0002 version again in case there's something wrong with the previous one.
>
> 2016-09-27 10:40 GMT-07:00 Eli Zaretskii <eliz@gnu.org <mailto:eliz@gnu.org>>:
>
> > From: Tianxiang Xiong <tianxiang.xiong@gmail.com <mailto:tianxiang.xiong@gmail.com>>
> > Date: Tue, 27 Sep 2016 09:30:18 -0700
> > Cc: emacs-devel@gnu.org <mailto:emacs-devel@gnu.org>, monnier@iro.umontreal.ca <mailto:monnier@iro.umontreal.ca>,
> > Clément Pit--Claudel <clement.pit@gmail.com <mailto:clement.pit@gmail.com>>
> >
> > Even the 0002 version?
>
> Yes.
>
>
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-28 4:21 ` Clément Pit--Claudel
@ 2016-09-30 7:34 ` Tianxiang Xiong
2016-09-30 13:20 ` Stefan Monnier
2016-10-03 13:57 ` Tino Calancha
0 siblings, 2 replies; 24+ messages in thread
From: Tianxiang Xiong @ 2016-09-30 7:34 UTC (permalink / raw)
To: Clément Pit--Claudel; +Cc: Eli Zaretskii, monnier, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1823 bytes --]
OK, I'll try to remove the whitespace changes.
On Tue, Sep 27, 2016 at 9:21 PM, Clément Pit--Claudel <clement.pit@gmail.com
> wrote:
> I think Eli is pointing out that in every place where you made a
> modification to the code, you also changed the whitespace. For example,
> you untabified all three lines of the following chunk.
>
> - (setq output
> - (format "This variable was introduced, or its default value
> was changed, in\nversion %s of Emacs.\n"
> - custom-version))
> + (setq output
> + (format "This variable was introduced, or its default value
> was changed, in version %s of Emacs.\n"
> + custom-version))
>
> Clément.
>
> On 2016-09-27 23:45, Tianxiang Xiong wrote:
> > @Eli I don't know what you mean, then. The diffs in the 0002 version are
> definitely not due to whitespace changes; I explicitly removed the
> whitespace-only changes from 0001.
> >
> > There /is/ a good amount of refactoring, simply because the previous
> code was very hard to follow. The new code is ~40 lines shorter and, if I
> do say so myself, much clearer.
> >
> > I've attached the 0002 version again in case there's something wrong
> with the previous one.
> >
> > 2016-09-27 10:40 GMT-07:00 Eli Zaretskii <eliz@gnu.org <mailto:
> eliz@gnu.org>>:
> >
> > > From: Tianxiang Xiong <tianxiang.xiong@gmail.com <mailto:
> tianxiang.xiong@gmail.com>>
> > > Date: Tue, 27 Sep 2016 09:30:18 -0700
> > > Cc: emacs-devel@gnu.org <mailto:emacs-devel@gnu.org>,
> monnier@iro.umontreal.ca <mailto:monnier@iro.umontreal.ca>,
> > > Clément Pit--Claudel <clement.pit@gmail.com <mailto:
> clement.pit@gmail.com>>
> > >
> > > Even the 0002 version?
> >
> > Yes.
> >
> >
>
>
[-- Attachment #2: Type: text/html, Size: 2911 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-09-30 7:34 ` Tianxiang Xiong
@ 2016-09-30 13:20 ` Stefan Monnier
2016-09-30 14:41 ` Stefan Monnier
2016-10-03 13:57 ` Tino Calancha
1 sibling, 1 reply; 24+ messages in thread
From: Stefan Monnier @ 2016-09-30 13:20 UTC (permalink / raw)
To: emacs-devel
> OK, I'll try to remove the whitespace changes.
AFAIK "diff -b" should do that for you.
Stefan
^ permalink raw reply [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
2016-09-30 7:34 ` Tianxiang Xiong
2016-09-30 13:20 ` Stefan Monnier
@ 2016-10-03 13:57 ` Tino Calancha
2016-10-08 21:51 ` Tianxiang Xiong
1 sibling, 1 reply; 24+ messages in thread
From: Tino Calancha @ 2016-10-03 13:57 UTC (permalink / raw)
To: Tianxiang Xiong
Cc: Eli Zaretskii, Emacs developers, Clément Pit--Claudel,
monnier
On Fri, 30 Sep 2016, Tianxiang Xiong wrote:
> OK, I'll try to remove the whitespace changes.
Hi Tianxiang,
i have three suggestions:
I)
i see your patch modified two functions:
`describe-variable-custom-version-info'
`describe-variable'
maybe, in addition to the patch, you can provide the log message
of the commit in Emacs format, i mean:
* lisp/help-fns.el (describe-variable-custom-version-info): blah, blah.
(describe-variable): blah, blah.
that could make much clear what is the rationale of your changes.
II)
I suggest to exclude from the patch the changes
princ --> insert
i guess the use of `princ' is intentional, in order to redirect the
standard output using:
(with-current-buffer standard-output
If you like, you might provide a patch made of two commits: the first one without
any princ --> insert changes, and then,
add a commit on top of the previous one providing these (princ ---> insert) changes.
III)
Do not drop embedded new lines as in:
(format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
or in:
(format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package"
Those newlines prevent to having lines longer than 80 lines. They are important.
Regards,
Tino
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-10-03 13:57 ` Tino Calancha
@ 2016-10-08 21:51 ` Tianxiang Xiong
2016-10-09 15:48 ` Tino Calancha
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-10-08 21:51 UTC (permalink / raw)
To: Tino Calancha
Cc: Eli Zaretskii, Emacs developers, Clément Pit--Claudel,
monnier
[-- Attachment #1.1: Type: text/plain, Size: 2227 bytes --]
Here's a version that fixes a few issues:
1. Rings are handled separately. Surprisingly, rings are sequences (satisfy
`sequencep`), but cannot be arguments to `length`. This seems like an
error. See this StackOverlow question for more:
http://emacs.stackexchange.com/questions/27335/rings-and-sequences
2. Large values are printed at the end, as before.
3. Regions have been tabified (is using tabs Emac Lisp style? It's
considered bad style for most languages).
4. Newlines in strings have been put back in place.
@Tino Seems to me that the use of `princ` is bad form for plain text, as is
wrapping separate sections in `(with-current-buffer standard-output)`. It's
easier to wrap everything in a top-level `(with-current-buffer
standard-output)` anyway.
TX
On Mon, Oct 3, 2016 at 6:57 AM, Tino Calancha <tino.calancha@gmail.com>
wrote:
>
>
> On Fri, 30 Sep 2016, Tianxiang Xiong wrote:
>
> OK, I'll try to remove the whitespace changes.
>>
> Hi Tianxiang,
>
> i have three suggestions:
>
> I)
>
> i see your patch modified two functions:
> `describe-variable-custom-version-info'
> `describe-variable'
>
> maybe, in addition to the patch, you can provide the log message
> of the commit in Emacs format, i mean:
>
> * lisp/help-fns.el (describe-variable-custom-version-info): blah, blah.
> (describe-variable): blah, blah.
>
> that could make much clear what is the rationale of your changes.
>
> II)
> I suggest to exclude from the patch the changes
> princ --> insert
> i guess the use of `princ' is intentional, in order to redirect the
> standard output using:
> (with-current-buffer standard-output
>
> If you like, you might provide a patch made of two commits: the first one
> without
> any princ --> insert changes, and then,
> add a commit on top of the previous one providing these (princ --->
> insert) changes.
>
> III)
> Do not drop embedded new lines as in:
> (format "This variable was introduced, or its default value was changed,
> in\nversion %s of Emacs.\n"
> or in:
> (format (concat "This variable was introduced, or its default value was
> changed, in\nversion %s of the %s package"
>
> Those newlines prevent to having lines longer than 80 lines. They are
> important.
>
> Regards,
> Tino
>
[-- Attachment #1.2: Type: text/html, Size: 3128 bytes --]
[-- Attachment #2: 0003-Use-font-lock-for-describe-variable.patch --]
[-- Type: text/x-patch, Size: 22879 bytes --]
From 8378d38839e4baf3cf809a688f1ad0d48a1da279 Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
Date: Sat, 24 Sep 2016 19:57:21 -0700
Subject: [PATCH] Use font-lock for `describe-variable`
As a side effect, clean up code.
---
ChangeLog.2 | 4 +
lisp/help-fns.el | 549 ++++++++++++++++++++++++++-----------------------------
2 files changed, 260 insertions(+), 293 deletions(-)
diff --git a/ChangeLog.2 b/ChangeLog.2
index 4e79295..c7ebcf0 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -1,3 +1,7 @@
+2016-10-08 Tianiang Xiong <tianxiang.xiong@gmail.com>
+
+ * lisp/help-fns.el (describe-variable): Use font lock, clean up
+ code etc.
2016-08-22 Philipp Stephani <phst@google.com>
Some assorted documentation clarifications
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e4e2333..9673ce4 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -35,6 +35,7 @@
(require 'cl-lib)
(require 'help-mode)
(require 'radix-tree)
+(require 'subr-x)
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
@@ -755,313 +756,275 @@ describe-variable-custom-version-info
;;;###autoload
(defun describe-variable (variable &optional buffer frame)
"Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also.
-If VARIABLE 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."
+
+Returns the documentation as a string.
+
+If VARIABLE has a buffer-local value in BUFFER or FRAME (default
+to the current buffer and frame), it is displayed along
+with the global value."
(interactive
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- (orig-buffer (current-buffer))
- val)
- (setq val (completing-read
- (if (symbolp v)
- (format
- "Describe variable (default %s): " v)
- "Describe variable: ")
- #'help--symbol-completion-table
- (lambda (vv)
- ;; In case the variable only exists in the buffer
- ;; the command we switch back to that buffer before
- ;; we examine the variable.
- (with-current-buffer orig-buffer
- (or (get vv 'variable-documentation)
- (and (boundp vv) (not (keywordp vv))))))
- t nil nil
- (if (symbolp v) (symbol-name v))))
- (list (if (equal val "")
- v (intern val)))))
- (let (file-name)
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (if (not (symbolp variable))
- (message "You did not specify a variable")
- (save-excursion
- (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- (permanent-local (get variable 'permanent-local))
- val val-start-pos locus)
- ;; Extract the value before setting up the output buffer,
- ;; in case `buffer' *is* the output buffer.
- (unless valvoid
- (with-selected-frame frame
- (with-current-buffer buffer
- (setq val (symbol-value variable)
- locus (variable-binding-locus variable)))))
- (help-setup-xref (list #'describe-variable variable buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (prin1 variable)
- (setq file-name (find-lisp-object-file-name variable 'defvar))
-
- (if file-name
- (progn
- (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)))
- (if valvoid
- (princ "It is void as a variable.")
- (princ "Its ")))
- (if valvoid
- (princ " is void as a variable.")
- (princ (substitute-command-keys "'s ")))))
- (unless valvoid
- (with-current-buffer standard-output
- (setq val-start-pos (point))
- (princ "value is")
- (let ((line-beg (line-beginning-position))
- (print-rep
- (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)
- (pp val)
- ;; Remove trailing newline.
- (delete-char -1))
- (let* ((sv (get variable 'standard-value))
- (origval (and (consp sv)
- (condition-case nil
- (eval (car sv))
- (error :help-eval-error))))
- from)
- (when (and (consp sv)
- (not (equal origval val))
- (not (equal origval :help-eval-error)))
- (princ "\nOriginal value was \n")
- (setq from (point))
- (pp origval)
- (if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri)
+ (let* ((v (variable-at-point))
+ (enable-recursive-minibuffers t)
+ (orig-buffer (current-buffer))
+ (val (completing-read
+ (if (symbolp v)
+ (format
+ "Describe variable (default %s): " v)
+ "Describe variable: ")
+ #'help--symbol-completion-table
+ (lambda (vv)
+ (with-current-buffer orig-buffer
+ (or (get vv 'variable-documentation)
+ (and (boundp vv) (not (keywordp vv))))))
+ t
+ nil
+ nil
+ (when (symbolp v) (symbol-name v)))))
+ (list (if (equal val "") v (intern val)))))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+
+ ;; Error if no variable is specified
+ (if (not (symbolp variable))
+ (user-error "%s" "You did not specify a variable"))
+
+ (save-excursion
+ (let* ((void (not (with-current-buffer buffer (boundp variable))))
+ (val (if void nil (symbol-value variable)))
+ (should-pp (and (sequencep val)
+ (let ((l (if (ring-p val)
+ (ring-length val)
+ (length val))))
+ (< l 500))))
+ (place-at-end (> (length (prin1-to-string val)) 3000))
+ (locus (variable-binding-locus variable)))
+ (cl-labels ((pretty-maybe (val)
+ (with-temp-buffer
+ (if (not should-pp)
+ (princ val (current-buffer))
+ (pp val (current-buffer))
+ (when (and (not (null val))
+ (not (stringp val))
+ (sequencep val))
+ (kill-backward-chars 1))
+ (emacs-lisp-mode)
+ (turn-on-font-lock)
+ (font-lock-ensure))
+ (buffer-string)))
+ (insert-value-section (val)
+ (if void
+ (insert "It is void as a variable.")
+ (if (and (or (null val)
+ (stringp val)
+ (not (sequencep val)))
+ (< (length (prin1-to-string val))
+ (- fill-column 13)))
+ (insert (format-message "Its value is %s.\n" (pretty-maybe val)))
+ (insert (format-message "Its value is:\n\n%s\n" (pretty-maybe val))))
+
+ ;; Original value
+ (let* ((sv (get variable 'standard-value))
+ (origval (and (consp sv)
+ (condition-case nil
+ (eval (car sv))
+ (error :help-eval-error)))))
+ (when (and (consp sv)
+ (not (equal origval val))
+ (not (equal origval :help-eval-error)))
+ (if (< (length (prin1-to-string origval))
+ (- fill-column 19))
+ (insert (format "Original value was %s.\n" (pretty-maybe origval)))
+ (insert (format "Original value was: \n\n%s" (pretty-maybe origval)))))))))
+ ;; Setup xrefs
+ (help-setup-xref (list #'describe-variable variable buffer)
+ (called-interactively-p 'interactive))
+
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ ;; Variable name
+ (insert (propertize (symbol-name variable)
+ 'face font-lock-variable-name-face))
+
+ ;; Definition file
+ (if-let ((file-name (find-lisp-object-file-name variable 'defvar)))
+ (progn
+ (insert " is a variable defined in ")
+ (if (eq file-name 'C-source)
+ (insert "C source code.")
+ (help-insert-xref-button (file-name-nondirectory file-name)
+ 'help-variable-def variable file-name)
+ (insert "."))))
+ (insert "\n\n")
+
+ ;; If value is not large, insert it here
+ ;; Otherwise, insert it later
+ (when (not place-at-end)
+ (insert-value-section val)
+ (insert "\n"))
+
+ ;; Locus (where variable's binding comes from)
(when locus
(cond
- ((bufferp locus)
- (princ (format "Local in buffer %s; "
- (buffer-name buffer))))
- ((framep locus)
- (princ (format "It is a frame-local variable; ")))
- ((terminal-live-p locus)
- (princ (format "It is a terminal-local variable; ")))
- (t
- (princ (format "It is local to %S" locus))))
+ ((bufferp locus)
+ (insert (format "It is local to buffer %s; "
+ (buffer-name locus))))
+ ((framep locus)
+ (insert (format "It is local to frame %s; "
+ (print1-to-string locus))))
+ ((terminal-live-p locus)
+ (insert (format "It is local to terminal %s; "
+ (prin1-to-string locus))))
+ (t
+ (insert (format "It is local to %s" locus))))
(if (not (default-boundp variable))
- (princ "globally void")
+ (insert "globally void")
(let ((global-val (default-value variable)))
(with-current-buffer standard-output
- (princ "global value is ")
+ (insert "global value is ")
(if (eq val global-val)
- (princ "the same.")
- (terpri)
- ;; Fixme: pp can take an age if you happen to
- ;; ask for a very large expression. We should
- ;; probably print it raw once and check it's a
- ;; sensible size before prettyprinting. -- fx
+ (insert "the same.")
+ (insert "\n")
(let ((from (point)))
- (pp global-val)
+ (pretty-maybe global-val)
;; See previous comment for this function.
;; (help-xref-on-pp from (point))
(if (< (point) (+ from 20))
- (delete-region (1- from) from)))))))
- (terpri))
-
- ;; If the value is large, move it to the end.
- (with-current-buffer standard-output
- (when (> (count-lines (point-min) (point-max)) 10)
- ;; Note that setting the syntax table like below
- ;; makes forward-sexp move over a `'s' at the end
- ;; of a symbol.
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (goto-char val-start-pos)
- ;; The line below previously read as
- ;; (delete-region (point) (progn (end-of-line) (point)))
- ;; which suppressed display of the buffer local value for
- ;; large values.
- (when (looking-at "value is") (replace-match ""))
- (save-excursion
- (insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
- (insert "value is shown ")
- (insert-button "below"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show value")
- (insert ".\n")))
- (terpri)
-
- (let* ((alias (condition-case nil
- (indirect-variable variable)
- (error variable)))
- (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))
-
- ;; Mention if it's a local variable.
- (cond
- ((and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (setq extra-line t)
- (princ " Automatically becomes ")
- (if permanent-local
- (princ "permanently "))
- (princ "buffer-local when set.\n"))
- ((not permanent-local))
- ((bufferp locus)
- (setq extra-line t)
- (princ
- (substitute-command-keys
- " This variable's buffer-local value is permanent.\n")))
- (t
- (setq extra-line t)
- (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-message
- " This variable is an alias for `%s'.\n"
- alias)))
-
- (when obsolete
- (setq extra-line t)
- (princ " This variable is obsolete")
- (if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))
-
- (when (member (cons variable val)
- (with-current-buffer buffer
- file-local-variables-alist))
- (setq extra-line t)
- (if (member (cons variable val)
- (with-current-buffer buffer
- dir-local-variables-alist))
- (let ((file (and (buffer-file-name buffer)
- (not (file-remote-p
- (buffer-file-name buffer)))
- (dir-locals-find-file
- (buffer-file-name buffer))))
- (is-directory nil))
- (princ (substitute-command-keys
- " This variable's value is directory-local"))
- (when (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- ;; (car file) is a directory.
- (setq file (dir-locals--all-files (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- is-directory t)))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((and (consp file) (cdr file))
- (setq file (file-name-directory (car file)))
- (format "by one of the\n %s files in the directory\n `"
- dir-locals-file))
- (t (setq file (car file))
- "by the file\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 (substitute-command-keys
- " This variable's value is file-local.\n"))))
-
- (when (memq variable ignored-local-variables)
- (setq extra-line t)
- (princ " This variable is ignored as a file-local \
-variable.\n"))
-
- ;; Can be both risky and safe, eg auto-fill-function.
- (when (risky-local-variable-p variable)
- (setq extra-line t)
- (princ " This variable may be risky if used as a \
-file-local variable.\n")
- (when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
- " However, you have added it to \
-`safe-local-variable-values'.\n"))))
-
- (when safe-var
- (setq extra-line t)
- (princ " This variable is safe as a file local variable ")
- (princ "if its value\n satisfies the predicate ")
- (princ (if (byte-code-function-p safe-var)
- "which is a byte-compiled expression.\n"
- (format-message "`%s'.\n" safe-var))))
-
- (if extra-line (terpri))
- (princ "Documentation:\n")
- (with-current-buffer standard-output
- (insert (or doc "Not documented as a variable."))))
-
- ;; Make a link to customize if this variable can be customized.
+ (delete-region (1- from) from))))))))
+
+ ;; Buffer local
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (insert "Automatically becomes ")
+ (if (get variable 'permanent-local)
+ (insert "permanently "))
+ (insert "buffer-local when set.\n\n"))
+ ((not (get variable 'permanent-local)))
+ ((bufferp locus)
+ (insert
+ (substitute-command-keys
+ "This variable's buffer-local value is permanent.\n\n")))
+ (t
+ (insert "This variable's value is permanent if it is given a local binding.\n\n")))
+
+ ;; Alias
+ (let ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable))))
+ (unless (eq alias variable)
+ (insert (format-message
+ "This variable is an alias for `%s'.\n\n" alias))))
+
+ ;; Obsolete
+ (let* ((obsolete (get variable 'byte-obsolete-variable))
+ (obsolete-since (nth 2 obsolete))
+ (use (car obsolete)))
+ (when obsolete-since
+ (insert (propertize (format-message "This variable is obsolete since %s" obsolete-since)
+ 'face 'error))
+ (insert (propertize (cond ((stringp use) (concat "; " use "\n"))
+ (use (format-message "; use `%s' instead.\n"
+ (car obsolete)))
+ (t ".\n"))
+ 'face 'error))
+ (insert "\n")))
+
+ ;; File or directory local
+ (when (member (cons variable val)
+ (with-current-buffer buffer
+ file-local-variables-alist))
+ (setq extra-line t)
+ (if (member (cons variable val)
+ (with-current-buffer buffer
+ dir-local-variables-alist))
+ (let ((file (and (buffer-file-name buffer)
+ (not (file-remote-p
+ (buffer-file-name buffer)))
+ (dir-locals-find-file
+ (buffer-file-name buffer))))
+ (is-directory nil))
+ (insert "This variable's value is directory-local")
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (insert ".\n")
+ (insert ", set ")
+ (insert (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
+ (help-insert-xref-button file 'help-dir-local-var-def
+ variable file)
+ (insert (substitute-command-keys "'.\n"))))
+ (insert "This variable's value is file-local.\n")))
+
+ ;; Ignored local
+ (when (memq variable ignored-local-variables)
+ (insert "This variable is ignored as a file-local variable.\n\n"))
+
+ ;; Risky local
+ (when (risky-local-variable-p variable)
+ (insert (propertize "This variable may be risky if used as a file-local variable"
+ 'face font-lock-warning-face))
+ (if (assq variable safe-local-variable-values)
+ (insert "; however, you have added it to `safe-local-variable-values'.\n"))
+ (insert ".\n\n"))
+
+ ;; Safe local
+ (when-let ((safe-var (get variable 'safe-local-variable)))
+ (insert "This variable is safe as a file local variable ")
+ (insert "if its value satisfies\nthe predicate ")
+ (insert (if (byte-code-function-p safe-var)
+ "which is a byte-compiled expression.\n\n"
+ (format-message "`%s'.\n\n" safe-var))))
+
+ ;; Documentation
+ (unless void
+ (let* ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable)))
+ (doc (or (documentation-property variable
+ 'variable-documentation)
+ (documentation-property alias
+ 'variable-documentation)
+ "Not documented as a variable.")))
+ (insert "Documentation:\n\n")
+ (insert (propertize doc 'face font-lock-doc-face))
+ (insert "\n\n")))
+
+ ;; If value is large, insert it here
+ (when place-at-end
+ (insert-value-section val))
+
+ ;; Make a link to customize if this variable can be
+ ;; customized.
(when (custom-variable-p variable)
- (let ((customize-label "customize"))
- (terpri)
- (terpri)
- (princ (concat "You can " customize-label " this variable."))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-variable variable))))
+ (insert "You can ")
+ (help-insert-xref-button "customize" 'help-customize-variable
+ variable)
+ (insert " this variable.")
;; Note variable's version or package version.
- (let ((output (describe-variable-custom-version-info variable)))
- (when output
- (terpri)
- (terpri)
- (princ output))))
-
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string))))))))
-
+ (when-let ((output (describe-variable-custom-version-info variable)))
+ (insert "\n\n")
+ (insert output)))
+ ;; Return the Help buffer string
+ (buffer-string)))))))
(defvar help-xref-stack-item)
;;;###autoload
--
2.7.4
^ permalink raw reply related [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
2016-10-08 21:51 ` Tianxiang Xiong
@ 2016-10-09 15:48 ` Tino Calancha
2016-10-11 4:11 ` Tianxiang Xiong
0 siblings, 1 reply; 24+ messages in thread
From: Tino Calancha @ 2016-10-09 15:48 UTC (permalink / raw)
To: Tianxiang Xiong
Cc: Eli Zaretskii, Emacs developers, Clément Pit--Claudel,
monnier, Tino Calancha
On Sat, 8 Oct 2016, Tianxiang Xiong wrote:
> Here's a version that fixes a few issues:
Thank you very much.
i have tested your patch and i have several comments.
I)
If you plan to fontify `describe-variable' then you should fontify
`describe-function' as well. Before your patch, the output of
these two functions looks similar. It would be confusing if
'd-v' uses `font-lock-doc-face' and 'd-f' do not.
II)
You dropped the button with label 'below' which appears when the
variable value is very long. Please, add this button.
See examples below.
III)
The condition to consider a variable value long in your patch is
different. In the example below, your patch shows a long var
value at the beginning, but without applying your patch it is shown
at the end. I guess, you are defining 'large' as a value
composed of >= 3000 characters. Please keep same definition
of variable being large as before your patch.
IV) Wouldn't be possible to show all the buttons with face 'button?
Even buttons inside the doc string. Before your patch is visually
very clear where there is a button; after your patch is less
clear because all doc string shows face `font-lock-doc-face'.
IV) The message 'Global value is', sometimes get confused and shows
things like:
global value is Documentation:
or
global value is Automatically becomes buffer-local when set.
See examples below.
VI) I found one inconsistency between using `F1-v' and `F1-o'
with a Elisp variable: they might report different variable
value after your patch.
See examples below.
Personally i like how Emacs currently shows 'd-v' and 'd-f'.
They look also consistent with `describe-mode'. I don't
see the necessity to apply the fontifications in your patch.
But this is just my opinion. Others may think differently.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EXAMPLES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Save following in a file /tmp/test.el
;;;;;;;;;;;;;;;;;;;;; FILE BEGIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local test-var nil
"Variable to test Xion patch.
When its value is long, `describe-variable' shows it at the end of
the *Help* buffer; in that case, there is one button with label
'below': pushing this button sets point to the buffer position
where the value is shown.
You should get the same documentation with `describe-symbol'.
Note that there is also a button in `describe-variable': pushing
it will show the documentation for describe-variable. This button
has face 'button, different from the rest of the text which shows
face 'default: that help users to visualize that there is a button.")
(setq test-var '(("/tmp/"
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "a"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "b"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "c"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "d"))
((foo . 3)
(bar . "123")
(baz . "456")
(qux . "e"))
((foo . 3)
(bar . "123")
(baz . "456")
(qux . "f"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "g"))
((foo . 3)
(bar . "123")
(baz . "456")
(qux . "h"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "i"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "j"))
((foo . 2)
(bar . "123")
(baz . "456")
(qux . "k")))))
;;;;;;;;;;;;;;;;;;;;; FILE END ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Compare w/ and w/o your patch:
[A]
emacs -Q -l /tmp/test.el
F1-v test-var RET
;; w/ patch: value appears at the beginning; value is non-nil.
;; w/o patch: value appears at end; button below is present.
F1-o test-var RET
;; w/ patch: value is nil.
;; w/o patch: value appears at end: same as using `F1-v'
;; button below is present.
[B]
emacs -Q
M-: (dired source-directory) RET
* /
M-: (save-excursion (mapc 'dired-maybe-insert-subdir (dired-get-marked-files))) RET
F1-v dired-subdir-alist RET
;; w/ patch: value appears at the beginning
;; w/o patch: value appears at the end; button 'below' OK.
;;; Add more subdirs
* /
M-: (save-excursion (mapc 'dired-maybe-insert-subdir (dired-get-marked-files))) RET
F1-v dired-subdir-alist RET
;; w/ patch: value appears at the end; no button 'below'.
;; w/o patch: value appears at the end; button 'below' OK.
^ permalink raw reply [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
2016-10-09 15:48 ` Tino Calancha
@ 2016-10-11 4:11 ` Tianxiang Xiong
2016-10-11 5:40 ` Tino Calancha
0 siblings, 1 reply; 24+ messages in thread
From: Tianxiang Xiong @ 2016-10-11 4:11 UTC (permalink / raw)
To: Tino Calancha
Cc: Eli Zaretskii, Emacs developers, Clément Pit--Claudel,
monnier
[-- Attachment #1: Type: text/plain, Size: 5495 bytes --]
@Tino Thanks, I'll take a look at these issues and create a new patch.
On Sun, Oct 9, 2016 at 8:48 AM, Tino Calancha <tino.calancha@gmail.com>
wrote:
>
>
> On Sat, 8 Oct 2016, Tianxiang Xiong wrote:
>
> Here's a version that fixes a few issues:
>>
> Thank you very much.
>
> i have tested your patch and i have several comments.
>
> I)
> If you plan to fontify `describe-variable' then you should fontify
> `describe-function' as well. Before your patch, the output of
> these two functions looks similar. It would be confusing if
> 'd-v' uses `font-lock-doc-face' and 'd-f' do not.
>
> II)
> You dropped the button with label 'below' which appears when the
> variable value is very long. Please, add this button.
> See examples below.
>
> III)
> The condition to consider a variable value long in your patch is
> different. In the example below, your patch shows a long var
> value at the beginning, but without applying your patch it is shown
> at the end. I guess, you are defining 'large' as a value
> composed of >= 3000 characters. Please keep same definition
> of variable being large as before your patch.
>
> IV) Wouldn't be possible to show all the buttons with face 'button?
> Even buttons inside the doc string. Before your patch is visually
> very clear where there is a button; after your patch is less
> clear because all doc string shows face `font-lock-doc-face'.
>
> IV) The message 'Global value is', sometimes get confused and shows
> things like:
> global value is Documentation:
> or
> global value is Automatically becomes buffer-local when set.
> See examples below.
>
> VI) I found one inconsistency between using `F1-v' and `F1-o'
> with a Elisp variable: they might report different variable
> value after your patch.
> See examples below.
>
> Personally i like how Emacs currently shows 'd-v' and 'd-f'.
> They look also consistent with `describe-mode'. I don't
> see the necessity to apply the fontifications in your patch.
> But this is just my opinion. Others may think differently.
>
>
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;;;;;;;;;;;;;;;;;;
> EXAMPLES
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;;;;;;;;;;;;;;;;;;
>
> Save following in a file /tmp/test.el
> ;;;;;;;;;;;;;;;;;;;;; FILE BEGIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;;;;;;;;;;;;;
> (defvar-local test-var nil
> "Variable to test Xion patch.
>
> When its value is long, `describe-variable' shows it at the end of
> the *Help* buffer; in that case, there is one button with label
> 'below': pushing this button sets point to the buffer position
> where the value is shown.
>
> You should get the same documentation with `describe-symbol'.
>
> Note that there is also a button in `describe-variable': pushing
> it will show the documentation for describe-variable. This button
> has face 'button, different from the rest of the text which shows
> face 'default: that help users to visualize that there is a button.")
> (setq test-var '(("/tmp/"
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "a"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "b"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "c"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "d"))
> ((foo . 3)
> (bar . "123")
> (baz . "456")
> (qux . "e"))
> ((foo . 3)
> (bar . "123")
> (baz . "456")
> (qux . "f"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "g"))
> ((foo . 3)
> (bar . "123")
> (baz . "456")
> (qux . "h"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "i"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "j"))
> ((foo . 2)
> (bar . "123")
> (baz . "456")
> (qux . "k")))))
> ;;;;;;;;;;;;;;;;;;;;; FILE END ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;;;;;;;;;;;;;
> Compare w/ and w/o your patch:
> [A]
> emacs -Q -l /tmp/test.el
> F1-v test-var RET
> ;; w/ patch: value appears at the beginning; value is non-nil.
> ;; w/o patch: value appears at end; button below is present.
>
> F1-o test-var RET
> ;; w/ patch: value is nil.
> ;; w/o patch: value appears at end: same as using `F1-v'
> ;; button below is present.
>
> [B]
> emacs -Q
> M-: (dired source-directory) RET
> * /
> M-: (save-excursion (mapc 'dired-maybe-insert-subdir
> (dired-get-marked-files))) RET
> F1-v dired-subdir-alist RET
> ;; w/ patch: value appears at the beginning
> ;; w/o patch: value appears at the end; button 'below' OK.
>
> ;;; Add more subdirs
> * /
> M-: (save-excursion (mapc 'dired-maybe-insert-subdir
> (dired-get-marked-files))) RET
> F1-v dired-subdir-alist RET
> ;; w/ patch: value appears at the end; no button 'below'.
> ;; w/o patch: value appears at the end; button 'below' OK.
>
[-- Attachment #2: Type: text/html, Size: 7427 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread* Re: Proposal: font lock for `describe-variable`
2016-10-11 4:11 ` Tianxiang Xiong
@ 2016-10-11 5:40 ` Tino Calancha
2016-10-11 5:51 ` Clément Pit--Claudel
0 siblings, 1 reply; 24+ messages in thread
From: Tino Calancha @ 2016-10-11 5:40 UTC (permalink / raw)
To: Tianxiang Xiong
Cc: Eli Zaretskii, Emacs developers, Clément Pit--Claudel,
monnier, Tino Calancha
On Mon, 10 Oct 2016, Tianxiang Xiong wrote:
> @Tino Thanks, I'll take a look at these issues and create a new patch.
Thank you.
Could you provide that fontification optionally? I mean, you
could add an user option, a.k.a., defcustom, which enable
those fontification. Some people may like your changes, so they
might want to set this new option non-nil.
Default for this option should be nil, i.e., show *Help* buffer
as it has being traditionaly shown.
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-10-11 5:40 ` Tino Calancha
@ 2016-10-11 5:51 ` Clément Pit--Claudel
2016-10-11 5:59 ` Tino Calancha
0 siblings, 1 reply; 24+ messages in thread
From: Clément Pit--Claudel @ 2016-10-11 5:51 UTC (permalink / raw)
To: Tino Calancha, Tianxiang Xiong; +Cc: Eli Zaretskii, monnier, Emacs developers
[-- Attachment #1.1: Type: text/plain, Size: 246 bytes --]
On 2016-10-11 01:40, Tino Calancha wrote:
> Default for this option should be nil, i.e., show *Help* buffer
> as it has being traditionaly shown.
Why? If this change is a good one, I think it should be on by default.
Cheers,
Clément.
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-10-11 5:51 ` Clément Pit--Claudel
@ 2016-10-11 5:59 ` Tino Calancha
2016-10-11 13:31 ` Clément Pit--Claudel
0 siblings, 1 reply; 24+ messages in thread
From: Tino Calancha @ 2016-10-11 5:59 UTC (permalink / raw)
To: Clément Pit--Claudel
Cc: Tianxiang Xiong, Emacs developers, Eli Zaretskii, monnier,
Tino Calancha
[-- Attachment #1: Type: text/plain, Size: 783 bytes --]
On Tue, 11 Oct 2016, Clément Pit--Claudel wrote:
> On 2016-10-11 01:40, Tino Calancha wrote:
>> Default for this option should be nil, i.e., show *Help* buffer
>> as it has being traditionaly shown.
>
> Why? If this change is a good one, I think it should be on by default.
Well, as you noticed the patch is kind of large. I think the parts
of the patch which rewrite the code, refactoring, making more clear,
robust, etc, of course should be _in_.
The cosmetic parts applying some fontification, for instance, showing
doc strings with doc font, could be optional. Some people may don't
like them. In my case i prefer how *Help* buffer looks now an i would be
dissapointed if after one 'git pull', i found that *Help* buffer looks
very different. But it's just my opinion :-)
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-10-11 5:59 ` Tino Calancha
@ 2016-10-11 13:31 ` Clément Pit--Claudel
2016-10-11 13:57 ` Tino Calancha
0 siblings, 1 reply; 24+ messages in thread
From: Clément Pit--Claudel @ 2016-10-11 13:31 UTC (permalink / raw)
To: Tino Calancha; +Cc: Tianxiang Xiong, Emacs developers, Eli Zaretskii, monnier
[-- Attachment #1.1: Type: text/plain, Size: 429 bytes --]
On 2016-10-11 01:59, Tino Calancha wrote:
> In my case i prefer how *Help* buffer looks now an i would be
> dissapointed if after one 'git pull', i found that *Help* buffer looks
> very different. But it's just my opinion :-)
Are there things the OP can do to minimize that disappointment? Can you suggest specific improvements?
Even having a switch seems dangerous to me. It's additional technical debt.
Clément.
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: Proposal: font lock for `describe-variable`
2016-10-11 13:31 ` Clément Pit--Claudel
@ 2016-10-11 13:57 ` Tino Calancha
0 siblings, 0 replies; 24+ messages in thread
From: Tino Calancha @ 2016-10-11 13:57 UTC (permalink / raw)
To: Clément Pit--Claudel
Cc: Tianxiang Xiong, Emacs developers, Eli Zaretskii, monnier,
Tino Calancha
[-- Attachment #1: Type: text/plain, Size: 1250 bytes --]
On Tue, 11 Oct 2016, Clément Pit--Claudel wrote:
> On 2016-10-11 01:59, Tino Calancha wrote:
>> In my case i prefer how *Help* buffer looks now an i would be
>> dissapointed if after one 'git pull', i found that *Help* buffer looks
>> very different. But it's just my opinion :-)
>
> Are there things the OP can do to minimize that disappointment?
My disappointment doesn't matter as longer as others find this patch
nicer than what we have now.
>Can you suggest specific improvements?
I can test the patch and report things that are not working properly
or that looks weird. It's what i have done. But I am not the right
person to suggest specific improvements in the fontification part
because i am not crazy with such fontifications: i do
like how *Help* buffer looks now after `F1-v'.
But I will suggest another thing. So far, the patch looks very large,
and it tries to perform 2 different tasks:
A) Simplify, refactorize the code.
B) Add fontification in some parts.
i am very interested in the part A. IMO it's easier to review this
if first one patch is presented doing just A). Then, once we are happy
with the first patch, the OP might prepare a patch on top of the previous
doing the remaining part, i.e., B).
Regards,
Tino
^ permalink raw reply [flat|nested] 24+ messages in thread
end of thread, other threads:[~2016-10-11 13:57 UTC | newest]
Thread overview: 24+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-09-25 3:36 Proposal: font lock for `describe-variable` Tianxiang Xiong
2016-09-25 14:47 ` Clément Pit--Claudel
2016-09-25 19:02 ` Stefan Monnier
2016-09-25 19:46 ` Clément Pit--Claudel
2016-09-25 21:12 ` Stefan Monnier
-- strict thread matches above, loose matches on Subject: below --
2016-09-25 18:25 Tianxiang Xiong
2016-09-27 4:09 Tianxiang Xiong
2016-09-27 15:49 ` Eli Zaretskii
2016-09-27 16:30 ` Tianxiang Xiong
2016-09-27 17:40 ` Eli Zaretskii
2016-09-28 3:45 ` Tianxiang Xiong
2016-09-28 4:21 ` Clément Pit--Claudel
2016-09-30 7:34 ` Tianxiang Xiong
2016-09-30 13:20 ` Stefan Monnier
2016-09-30 14:41 ` Stefan Monnier
2016-10-03 13:57 ` Tino Calancha
2016-10-08 21:51 ` Tianxiang Xiong
2016-10-09 15:48 ` Tino Calancha
2016-10-11 4:11 ` Tianxiang Xiong
2016-10-11 5:40 ` Tino Calancha
2016-10-11 5:51 ` Clément Pit--Claudel
2016-10-11 5:59 ` Tino Calancha
2016-10-11 13:31 ` Clément Pit--Claudel
2016-10-11 13:57 ` Tino Calancha
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).