Tweak how shortdocs are displayed

* lisp/emacs-lisp/shortdoc.el (shortdoc-example): Removed.
(shortdoc-section): Remove colors.
(shortdoc-separator): New face.
(shortdoc-display-group, shortdoc--display-function): Don't use
background colours, because that makes things harder to read.
Separate with a horizontal line instead.
This commit is contained in:
Lars Ingebrigtsen 2020-10-26 13:12:34 +01:00
parent 1e8f15ee04
commit d23e483cfb

View file

@ -31,19 +31,17 @@
"Short documentation." "Short documentation."
:group 'lisp) :group 'lisp)
(defface shortdoc-section (defface shortdoc-separator
'((((class color) (background dark)) '((((class color) (background dark))
:inherit variable-pitch :background "#303030" :extend t) :height 0.1 :background "#505050" :extend t)
(((class color) (background light)) (((class color) (background light))
:inherit variable-pitch :background "#f0f0f0" :extend t)) :height 0.1 :background "#a0a0a0" :extend t)
"Face used for a section.") (t :height 0.1 :inverse-video t :extend t))
"Face used to separate sections.")
(defface shortdoc-example (defface shortdoc-section
'((((class color) (background dark)) '((t :inherit variable-pitch))
:background "#202020" :extend t) "Face used for a section.")
(((class color) (background light))
:background "#e8e8e8" :extend t))
"Face used for examples.")
(defvar shortdoc--groups nil) (defvar shortdoc--groups nil)
@ -1040,7 +1038,8 @@ There can be any number of :example/:result elements."
(unless (assq group shortdoc--groups) (unless (assq group shortdoc--groups)
(error "No such documentation group %s" group)) (error "No such documentation group %s" group))
(pop-to-buffer (format "*Shortdoc %s*" group)) (pop-to-buffer (format "*Shortdoc %s*" group))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t)
(prev nil))
(erase-buffer) (erase-buffer)
(special-mode) (special-mode)
(button-mode) (button-mode)
@ -1048,11 +1047,17 @@ There can be any number of :example/:result elements."
(lambda (data) (lambda (data)
(cond (cond
((stringp data) ((stringp data)
(setq prev nil)
(unless (bobp)
(insert "\n"))
(insert (propertize (insert (propertize
(concat data "\n\n") (concat data "\n\n")
'face '(variable-pitch (:height 1.3 :weight bold))))) 'face '(variable-pitch (:height 1.3 :weight bold)))))
;; There may be functions not yet defined in the data. ;; There may be functions not yet defined in the data.
((fboundp (car data)) ((fboundp (car data))
(when prev
(insert (propertize "\n" 'face 'shortdoc-separator)))
(setq prev t)
(shortdoc--display-function data)))) (shortdoc--display-function data))))
(cdr (assq group shortdoc--groups)))) (cdr (assq group shortdoc--groups))))
(goto-char (point-min))) (goto-char (point-min)))
@ -1078,8 +1083,7 @@ There can be any number of :example/:result elements."
(car (split-string (documentation function) "\n")))) (car (split-string (documentation function) "\n"))))
(insert "\n") (insert "\n")
(add-face-text-property start-section (point) 'shortdoc-section t) (add-face-text-property start-section (point) 'shortdoc-section t)
(let ((start (point)) (let ((print-escape-newlines t)
(print-escape-newlines t)
(double-arrow (if (char-displayable-p ?⇒) (double-arrow (if (char-displayable-p ?⇒)
"" ""
"=>")) "=>"))
@ -1134,9 +1138,7 @@ There can be any number of :example/:result elements."
(:eg-result-string (:eg-result-string
(insert " eg. " double-arrow " ") (insert " eg. " double-arrow " ")
(princ value (current-buffer)) (princ value (current-buffer))
(insert "\n")))) (insert "\n")))))
(put-text-property start (point) 'face 'shortdoc-example))
(insert "\n")
;; Insert the arglist after doing the evals, in case that's pulled ;; Insert the arglist after doing the evals, in case that's pulled
;; in the function definition. ;; in the function definition.
(save-excursion (save-excursion