all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* 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-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
* 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

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-27  4:09 Proposal: font lock for `describe-variable` 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
  -- strict thread matches above, loose matches on Subject: below --
2016-09-25 18:25 Tianxiang Xiong
2016-09-25  3:36 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

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.