[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 49422d2: Do not buttonize key bindings outside of *Help* buffers
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 49422d2: Do not buttonize key bindings outside of *Help* buffers |
|
Date: |
Mon, 29 Nov 2021 09:14:12 -0500 (EST) |
branch: master
commit 49422d2e6986d3ec161e194c73c38f2a7c4b3c64
Author: Gregory Heytings <gregory@heytings.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Do not buttonize key bindings outside of *Help* buffers
* etc/NEWS: Mention the new variable.
* lisp/apropos.el (apropos-describe-plist): Bind the new
variable (bug#52053).
* lisp/button.el (button-describe): Bind the new variable.
* lisp/help-fns.el (describe-function, describe-variable)
(describe-face, describe-symbol, describe-syntax)
(describe-categories, describe-keymap, describe-mode)
(describe-widget): Bind the new variable.
* lisp/help-macro.el (make-help-screen): Bind the new variable.
* lisp/help.el (help-buffer-under-preparation): New variable
that is bound to t by commands that create a *Help* buffer.
(substitute-command-keys): Use the new variable:
help-link-key-to-documentation is supposed to have an effect
only "in *Help* buffers". Fixes bug#52053.
(view-lossage, describe-bindings, describe-key): Bind the new
variable.
* lisp/repeat.el (describe-repeat-maps): Bind the new variable.
* lisp/international/mule-cmds.el (describe-input-method)
(describe-language-environment): Bind the new variable.
* lisp/international/mule-diag.el (describe-character-set)
(describe-coding-system, describe-font, describe-fontset)
((list-fontsets): Bind the new variable.
---
etc/NEWS | 3 +
lisp/apropos.el | 23 +-
lisp/button.el | 3 +-
lisp/help-fns.el | 549 ++++++++++++++++++++--------------------
lisp/help-macro.el | 3 +-
lisp/help.el | 109 ++++----
lisp/international/mule-cmds.el | 216 ++++++++--------
lisp/international/mule-diag.el | 360 +++++++++++++-------------
lisp/repeat.el | 51 ++--
9 files changed, 675 insertions(+), 642 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 87a7a43..ba28066 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -992,6 +992,9 @@ that should be displayed, and the xwidget that asked to
display it.
This function is used to control where and if an xwidget stores
cookies set by web pages on disk.
+** New variable 'help-buffer-under-preparation'.
+This variable is bound to t during the preparation of a *Help* buffer.
+
* Changes in Emacs 29.1 on Non-Free Operating Systems
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 00919ed..66a594d 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1322,17 +1322,18 @@ as a heading."
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
- (help-setup-xref (list 'apropos-describe-plist symbol)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (set-buffer standard-output)
- (princ "Symbol ")
- (prin1 symbol)
- (princ (substitute-command-keys "'s plist is\n ("))
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face 'apropos-symbol)
- (insert (apropos-format-plist symbol "\n "))
- (princ ")")))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list 'apropos-describe-plist symbol)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (set-buffer standard-output)
+ (princ "Symbol ")
+ (prin1 symbol)
+ (princ (substitute-command-keys "'s plist is\n ("))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
+ (insert (apropos-format-plist symbol "\n "))
+ (princ ")"))))
(provide 'apropos)
diff --git a/lisp/button.el b/lisp/button.el
index e3f91cb..dd5a71d 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -604,7 +604,8 @@ When called from Lisp, pass BUTTON-OR-POS as the button to
describe, or a
buffer position where a button is present. If BUTTON-OR-POS is nil, the
button at point is the button to describe."
(interactive "d")
- (let* ((button (cond ((integer-or-marker-p button-or-pos)
+ (let* ((help-buffer-under-preparation t)
+ (button (cond ((integer-or-marker-p button-or-pos)
(button-at button-or-pos))
((null button-or-pos) (button-at (point)))
((overlayp button-or-pos) button-or-pos)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 17fabe4..3269842 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -249,7 +249,8 @@ handling of autoloaded functions."
;; calling that.
(let ((describe-function-orig-buffer
(or describe-function-orig-buffer
- (current-buffer))))
+ (current-buffer)))
+ (help-buffer-under-preparation t))
(help-setup-xref
(list (lambda (function buffer)
@@ -1078,7 +1079,8 @@ it is displayed along with the global value."
(if (symbolp v) (symbol-name v))))
(list (if (equal val "")
v (intern val)))))
- (let (file-name)
+ (let (file-name
+ (help-buffer-under-preparation t))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(unless (frame-live-p frame) (setq frame (selected-frame)))
(if (not (symbolp variable))
@@ -1461,77 +1463,78 @@ If FRAME is omitted or nil, use the selected frame."
(interactive (list (read-face-name "Describe face"
(or (face-at-point t) 'default)
t)))
- (help-setup-xref (list #'describe-face face)
- (called-interactively-p 'interactive))
- (unless face
- (setq face 'default))
- (if (not (listp face))
- (setq face (list face)))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (dolist (f face (buffer-string))
- (if (stringp f) (setq f (intern f)))
- ;; We may get called for anonymous faces (i.e., faces
- ;; expressed using prop-value plists). Those can't be
- ;; usefully customized, so ignore them.
- (when (symbolp f)
- (insert "Face: " (symbol-name f))
- (if (not (facep f))
- (insert " undefined face.\n")
- (let ((customize-label "customize this face")
- file-name)
- (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
- (princ (concat " (" customize-label ")\n"))
- ;; FIXME not sure how much of this belongs here, and
- ;; how much in `face-documentation'. The latter is
- ;; not used much, but needs to return nil for
- ;; undocumented faces.
- (let ((alias (get f 'face-alias))
- (face f)
- obsolete)
- (when alias
- (setq face alias)
- (insert
- (format-message
- "\n %s is an alias for the face `%s'.\n%s"
- f alias
- (if (setq obsolete (get f 'obsolete-face))
- (format-message
- " This face is obsolete%s; use `%s' instead.\n"
- (if (stringp obsolete)
- (format " since %s" obsolete)
- "")
- alias)
- ""))))
- (insert "\nDocumentation:\n"
- (substitute-command-keys
- (or (face-documentation face)
- "Not documented as a face."))
- "\n\n"))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-face f)))
- (setq file-name (find-lisp-object-file-name f 'defface))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol f))
- (setq help-mode--current-data (list :symbol f
- :file file-name))
- (princ (substitute-command-keys "Defined in `"))
- (princ (help-fns-short-filename file-name))
- (princ (substitute-command-keys "'"))
- ;; Make a hyperlink to the library.
- (save-excursion
- (re-search-backward
- (substitute-command-keys "`\\([^`']+\\)'") nil t)
- (help-xref-button 1 'help-face-def f file-name))
- (princ ".")
- (terpri)
- (terpri))))
- (terpri)
- (help-fns--run-describe-functions
- help-fns-describe-face-functions f frame))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-face face)
+ (called-interactively-p 'interactive))
+ (unless face
+ (setq face 'default))
+ (if (not (listp face))
+ (setq face (list face)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (dolist (f face (buffer-string))
+ (if (stringp f) (setq f (intern f)))
+ ;; We may get called for anonymous faces (i.e., faces
+ ;; expressed using prop-value plists). Those can't be
+ ;; usefully customized, so ignore them.
+ (when (symbolp f)
+ (insert "Face: " (symbol-name f))
+ (if (not (facep f))
+ (insert " undefined face.\n")
+ (let ((customize-label "customize this face")
+ file-name)
+ (insert (concat " (" (propertize "sample" 'font-lock-face f)
")"))
+ (princ (concat " (" customize-label ")\n"))
+ ;; FIXME not sure how much of this belongs here, and
+ ;; how much in `face-documentation'. The latter is
+ ;; not used much, but needs to return nil for
+ ;; undocumented faces.
+ (let ((alias (get f 'face-alias))
+ (face f)
+ obsolete)
+ (when alias
+ (setq face alias)
+ (insert
+ (format-message
+ "\n %s is an alias for the face `%s'.\n%s"
+ f alias
+ (if (setq obsolete (get f 'obsolete-face))
+ (format-message
+ " This face is obsolete%s; use `%s' instead.\n"
+ (if (stringp obsolete)
+ (format " since %s" obsolete)
+ "")
+ alias)
+ ""))))
+ (insert "\nDocumentation:\n"
+ (substitute-command-keys
+ (or (face-documentation face)
+ "Not documented as a face."))
+ "\n\n"))
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward
+ (concat "\\(" customize-label "\\)") nil t)
+ (help-xref-button 1 'help-customize-face f)))
+ (setq file-name (find-lisp-object-file-name f 'defface))
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol f))
+ (setq help-mode--current-data (list :symbol f
+ :file file-name))
+ (princ (substitute-command-keys "Defined in `"))
+ (princ (help-fns-short-filename file-name))
+ (princ (substitute-command-keys "'"))
+ ;; Make a hyperlink to the library.
+ (save-excursion
+ (re-search-backward
+ (substitute-command-keys "`\\([^`']+\\)'") nil t)
+ (help-xref-button 1 'help-face-def f file-name))
+ (princ ".")
+ (terpri)
+ (terpri))))
+ (terpri)
+ (help-fns--run-describe-functions
+ help-fns-describe-face-functions f frame)))))))
(add-hook 'help-fns-describe-face-functions
#'help-fns--face-custom-version-info)
@@ -1602,43 +1605,44 @@ current buffer and the selected frame, respectively."
(if found (symbol-name v-or-f)))))
(list (if (equal val "")
(or 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)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (with-current-buffer (help-buffer)
- ;; Push the previous item on the stack before clobbering the output buffer.
- (help-setup-xref nil nil)
- (let* ((docs
- (nreverse
- (delq nil
- (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
- (when (funcall testfn symbol)
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (cons name
- (funcall descfn symbol buffer frame))))
- describe-symbol-backends))))
- (single (null (cdr docs))))
- (while (cdr docs)
- (goto-char (point-min))
- (let ((inhibit-read-only t)
- (name (caar docs)) ;Name of doc currently at BOB.
- (doc (cdr (cadr docs)))) ;Doc to add at BOB.
- (when doc
- (insert doc)
- (delete-region (point)
- (progn (skip-chars-backward " \t\n") (point)))
- (insert "\n\n" (make-separator-line) "\n")
- (when name
- (insert (symbol-name symbol)
- " is also a " name "." "\n\n"))))
- (setq docs (cdr docs)))
- (unless single
- ;; Don't record the `describe-variable' item in the stack.
- (setq help-xref-stack-item nil)
- (help-setup-xref (list #'describe-symbol symbol) nil))
- (goto-char (point-min)))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (symbolp symbol))
+ (user-error "You didn't specify a function or variable"))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+ (with-current-buffer (help-buffer)
+ ;; Push the previous item on the stack before clobbering the output
buffer.
+ (help-setup-xref nil nil)
+ (let* ((docs
+ (nreverse
+ (delq nil
+ (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
+ (when (funcall testfn symbol)
+ ;; Don't record the current entry in the
stack.
+ (setq help-xref-stack-item nil)
+ (cons name
+ (funcall descfn symbol buffer frame))))
+ describe-symbol-backends))))
+ (single (null (cdr docs))))
+ (while (cdr docs)
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (name (caar docs)) ;Name of doc currently at BOB.
+ (doc (cdr (cadr docs)))) ;Doc to add at BOB.
+ (when doc
+ (insert doc)
+ (delete-region (point)
+ (progn (skip-chars-backward " \t\n") (point)))
+ (insert "\n\n" (make-separator-line) "\n")
+ (when name
+ (insert (symbol-name symbol)
+ " is also a " name "." "\n\n"))))
+ (setq docs (cdr docs)))
+ (unless single
+ ;; Don't record the `describe-variable' item in the stack.
+ (setq help-xref-stack-item nil)
+ (help-setup-xref (list #'describe-symbol symbol) nil))
+ (goto-char (point-min))))))
;;;###autoload
(defun describe-syntax (&optional buffer)
@@ -1647,15 +1651,16 @@ The descriptions are inserted in a help buffer, which
is then displayed.
BUFFER defaults to the current buffer."
(interactive)
(setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-syntax buffer)
- (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))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-syntax buffer)
+ (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)))))))
(defun help-describe-category-set (value)
(insert (cond
@@ -1672,59 +1677,60 @@ The descriptions are inserted in a buffer, which is
then displayed.
If BUFFER is non-nil, then describe BUFFER's category table instead.
BUFFER should be a buffer or a buffer name."
(interactive)
- (setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-categories buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (let* ((table (with-current-buffer buffer (category-table)))
- (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"))
- (with-current-buffer standard-output
- (setq-default help-button-cache (make-marker))
- (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)
+ (let ((help-buffer-under-preparation t))
+ (setq buffer (or buffer (current-buffer)))
+ (help-setup-xref (list #'describe-categories buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (let* ((table (with-current-buffer buffer (category-table)))
+ (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"))
+ (with-current-buffer standard-output
+ (setq-default help-button-cache (make-marker))
+ (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)
+ (set-marker help-button-cache (point))
+ (insert "Legend of category mnemonics:\n")
(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))))))
+ (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)))))))
(defun help-fns-find-keymap-name (keymap)
"Find the name of the variable with value KEYMAP.
@@ -1778,7 +1784,8 @@ keymap value."
(unless (and km (keymapp (symbol-value km)))
(user-error "Not a keymap: %s" km))
(list km)))
- (let (used-gentemp)
+ (let (used-gentemp
+ (help-buffer-under-preparation t))
(unless (and (symbolp keymap)
(boundp keymap)
(keymapp (symbol-value keymap)))
@@ -1844,106 +1851,107 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer."
(interactive "@")
- (unless buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-mode buffer)
- (called-interactively-p 'interactive))
- ;; For the sake of help-do-xref and help-xref-go-back,
- ;; don't switch buffers before calling `help-buffer'.
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (let (minors)
- ;; Older packages do not register in minor-mode-list but only in
- ;; minor-mode-alist.
- (dolist (x minor-mode-alist)
- (setq x (car x))
- (unless (memq x minor-mode-list)
- (push x minor-mode-list)))
- ;; Find enabled minor mode we will want to mention.
- (dolist (mode minor-mode-list)
- ;; Document a minor mode if it is listed in minor-mode-alist,
- ;; non-nil, and has a function definition.
- (let ((fmode (or (get mode :minor-mode-function) mode)))
- (and (boundp mode) (symbol-value mode)
- (fboundp fmode)
- (let ((pretty-minor-mode
- (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
- (symbol-name fmode))
- (capitalize
- (substring (symbol-name fmode)
- 0 (match-beginning 0)))
- fmode)))
- (push (list fmode pretty-minor-mode
- (format-mode-line (assq mode minor-mode-alist)))
- minors)))))
- ;; Narrowing is not a minor mode, but its indicator is part of
- ;; mode-line-modes.
- (when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minors))
- (setq minors
- (sort minors
- (lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minors
- (princ "Enabled minor modes:\n")
- (make-local-variable 'help-button-cache)
- (with-current-buffer standard-output
- (dolist (mode minors)
- (let ((mode-function (nth 0 mode))
- (pretty-minor-mode (nth 1 mode))
- (indicator (nth 2 mode)))
- (save-excursion
- (goto-char (point-max))
- (princ "\n\f\n")
- (push (point-marker) help-button-cache)
- ;; Document the minor modes fully.
- (insert-text-button
- pretty-minor-mode 'type 'help-function
- 'help-args (list mode-function)
- 'button '(t))
- (princ (format " minor mode (%s):\n"
- (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s"
- indicator))))
- (princ (help-split-fundoc (documentation mode-function)
- nil 'doc)))
- (insert-button pretty-minor-mode
- 'action (car help-button-cache)
- 'follow-link t
- 'help-echo "mouse-2, RET: show full information")
- (newline)))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-line 1))
-
- (princ "\n(Information about these minor modes follows the major mode
info.)\n\n"))
- ;; Document the major mode.
- (let ((mode mode-name))
- (with-current-buffer standard-output
- (let ((start (point)))
- (insert (format-mode-line mode nil nil buffer))
- (add-text-properties start (point) '(face bold)))))
- (princ " mode")
- (let* ((mode major-mode)
- (file-name (find-lisp-object-file-name mode nil)))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol mode))
- (princ (format-message " defined in `%s'"
- (help-fns-short-filename file-name)))
- ;; Make a hyperlink to the library.
+ (let ((help-buffer-under-preparation t))
+ (unless buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-mode buffer)
+ (called-interactively-p 'interactive))
+ ;; For the sake of help-do-xref and help-xref-go-back,
+ ;; don't switch buffers before calling `help-buffer'.
+ (with-help-window (help-buffer)
+ (with-current-buffer buffer
+ (let (minors)
+ ;; Older packages do not register in minor-mode-list but only in
+ ;; minor-mode-alist.
+ (dolist (x minor-mode-alist)
+ (setq x (car x))
+ (unless (memq x minor-mode-list)
+ (push x minor-mode-list)))
+ ;; Find enabled minor mode we will want to mention.
+ (dolist (mode minor-mode-list)
+ ;; Document a minor mode if it is listed in minor-mode-alist,
+ ;; non-nil, and has a function definition.
+ (let ((fmode (or (get mode :minor-mode-function) mode)))
+ (and (boundp mode) (symbol-value mode)
+ (fboundp fmode)
+ (let ((pretty-minor-mode
+ (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+ (symbol-name fmode))
+ (capitalize
+ (substring (symbol-name fmode)
+ 0 (match-beginning 0)))
+ fmode)))
+ (push (list fmode pretty-minor-mode
+ (format-mode-line (assq mode
minor-mode-alist)))
+ minors)))))
+ ;; Narrowing is not a minor mode, but its indicator is part of
+ ;; mode-line-modes.
+ (when (buffer-narrowed-p)
+ (push '(narrow-to-region "Narrow" " Narrow") minors))
+ (setq minors
+ (sort minors
+ (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+ (when minors
+ (princ "Enabled minor modes:\n")
+ (make-local-variable 'help-button-cache)
(with-current-buffer standard-output
- (save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
- (setq help-mode--current-data (list :symbol mode
- :file file-name))
- (help-xref-button 1 'help-function-def mode file-name)))))
- (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
- (with-current-buffer standard-output
- (insert ":\n")
- (insert fundoc)
- (insert (help-fns--list-local-commands)))))))
- ;; For the sake of IELM and maybe others
- nil)
+ (dolist (mode minors)
+ (let ((mode-function (nth 0 mode))
+ (pretty-minor-mode (nth 1 mode))
+ (indicator (nth 2 mode)))
+ (save-excursion
+ (goto-char (point-max))
+ (princ "\n\f\n")
+ (push (point-marker) help-button-cache)
+ ;; Document the minor modes fully.
+ (insert-text-button
+ pretty-minor-mode 'type 'help-function
+ 'help-args (list mode-function)
+ 'button '(t))
+ (princ (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator))))
+ (princ (help-split-fundoc (documentation mode-function)
+ nil 'doc)))
+ (insert-button pretty-minor-mode
+ 'action (car help-button-cache)
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full
information")
+ (newline)))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-line 1))
+
+ (princ "\n(Information about these minor modes follows the major
mode info.)\n\n"))
+ ;; Document the major mode.
+ (let ((mode mode-name))
+ (with-current-buffer standard-output
+ (let ((start (point)))
+ (insert (format-mode-line mode nil nil buffer))
+ (add-text-properties start (point) '(face bold)))))
+ (princ " mode")
+ (let* ((mode major-mode)
+ (file-name (find-lisp-object-file-name mode nil)))
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol mode))
+ (princ (format-message " defined in `%s'"
+ (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 "`\\([^`']+\\)'")
+ nil t)
+ (setq help-mode--current-data (list :symbol mode
+ :file file-name))
+ (help-xref-button 1 'help-function-def mode file-name)))))
+ (let ((fundoc (help-split-fundoc (documentation major-mode) nil
'doc)))
+ (with-current-buffer standard-output
+ (insert ":\n")
+ (insert fundoc)
+ (insert (help-fns--list-local-commands))))))))
+ ;; For the sake of IELM and maybe others
+ nil)
(defun help-fns--list-local-commands ()
(let ((functions nil))
@@ -1998,7 +2006,8 @@ one of them returns non-nil."
(event-end key))
((eq key ?\C-g) (signal 'quit nil))
(t (user-error "You didn't specify a widget"))))))
- (let (buf)
+ (let (buf
+ (help-buffer-under-preparation t))
;; Allow describing a widget in a different window.
(when (posnp pos)
(setq buf (window-buffer (posn-window pos))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 588efee..cd1b51e 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -93,7 +93,8 @@ and then returns."
"Help command."
(interactive)
(let ((line-prompt
- (substitute-command-keys ,help-line)))
+ (substitute-command-keys ,help-line))
+ (help-buffer-under-preparation t))
(when three-step-help
(message "%s" line-prompt))
(let* ((help-screen ,help-text)
diff --git a/lisp/help.el b/lisp/help.el
index 9122d96..1917ef4 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -50,6 +50,11 @@
(defvar help-window-old-frame nil
"Frame selected at the time `with-help-window' is invoked.")
+(defvar help-buffer-under-preparation nil
+ "Whether a *Help* buffer is being prepared.
+This variable is bound to t during the preparation of a *Help*
+buffer.")
+
(defvar help-map
(let ((map (make-sparse-keymap)))
(define-key map (char-to-string help-char) 'help-for-help)
@@ -524,30 +529,31 @@ See `lossage-size' to update the number of recorded
keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
- (help-setup-xref (list #'view-lossage)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (princ " ")
- (princ (mapconcat (lambda (key)
- (cond
- ((and (consp key) (null (car key)))
- (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
- "anonymous-command")))
- ((or (integerp key) (symbolp key) (listp key))
- (single-key-description key))
- (t
- (prin1-to-string key nil))))
- (recent-keys 'include-cmds)
- " "))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (let ((comment-start ";; ")
- (comment-column 24))
- (while (not (eobp))
- (comment-indent)
- (forward-line 1)))
- ;; Show point near the end of "lossage", as we did in Emacs 24.
- (set-marker help-window-point-marker (point)))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'view-lossage)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (princ " ")
+ (princ (mapconcat (lambda (key)
+ (cond
+ ((and (consp key) (null (car key)))
+ (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
+ "anonymous-command")))
+ ((or (integerp key) (symbolp key) (listp key))
+ (single-key-description key))
+ (t
+ (prin1-to-string key nil))))
+ (recent-keys 'include-cmds)
+ " "))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (let ((comment-start ";; ")
+ (comment-column 24))
+ (while (not (eobp))
+ (comment-indent)
+ (forward-line 1)))
+ ;; Show point near the end of "lossage", as we did in Emacs 24.
+ (set-marker help-window-point-marker (point))))))
;; Key bindings
@@ -579,31 +585,32 @@ The optional argument BUFFER specifies which buffer's
bindings
to display (default, the current buffer). BUFFER can be a buffer
or a buffer name."
(interactive)
- (or buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-bindings prefix buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer (help-buffer)
- (describe-buffer-bindings buffer prefix)
-
- (when describe-bindings-outline
- (setq-local outline-regexp ".*:$")
- (setq-local outline-heading-end-regexp ":\n")
- (setq-local outline-level (lambda () 1))
- (setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
- (setq-local outline-minor-mode-use-buttons t)
- (outline-minor-mode 1)
- (save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- ;; Hide the longest body.
- (when (re-search-forward "Key translations" nil t)
- (outline-hide-subtree))
- ;; Hide ^Ls.
- (while (search-forward "\n\f\n" nil t)
- (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
- 'invisible t))))))))
+ (let ((help-buffer-under-preparation t))
+ (or buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-bindings prefix buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (describe-buffer-bindings buffer prefix)
+
+ (when describe-bindings-outline
+ (setq-local outline-regexp ".*:$")
+ (setq-local outline-heading-end-regexp ":\n")
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t)
+ (setq-local outline-minor-mode-use-buttons t)
+ (outline-minor-mode 1)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ ;; Hide the longest body.
+ (when (re-search-forward "Key translations" nil t)
+ (outline-hide-subtree))
+ ;; Hide ^Ls.
+ (while (search-forward "\n\f\n" nil t)
+ (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
+ 'invisible t)))))))))
(defun where-is (definition &optional insert)
"Print message listing key sequences that invoke the command DEFINITION.
@@ -907,7 +914,8 @@ current buffer."
(let ((raw (if (numberp buffer) (this-single-command-raw-keys) buffer)))
(setf (cdar (last key-list)) raw)))
(setq buffer nil))
- (let* ((buf (or buffer (current-buffer)))
+ (let* ((help-buffer-under-preparation t)
+ (buf (or buffer (current-buffer)))
(on-link
(mapcar (lambda (kr)
(let ((raw (cdr kr)))
@@ -1181,6 +1189,7 @@ Otherwise, return a new string."
(delete-char (- end-point (point)))
(let ((key (help--key-description-fontified key)))
(insert (if (and help-link-key-to-documentation
+ help-buffer-under-preparation
(functionp fun))
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index b922f19..9f3f2a2 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1638,30 +1638,31 @@ If `default-transient-input-method' was not yet
defined, prompt for it."
(interactive
(list (read-input-method-name
(format-prompt "Describe input method" current-input-method))))
- (if (and input-method (symbolp input-method))
- (setq input-method (symbol-name input-method)))
- (help-setup-xref (list #'describe-input-method
- (or input-method current-input-method))
- (called-interactively-p 'interactive))
-
- (if (null input-method)
- (describe-current-input-method)
- (let ((current current-input-method))
- (condition-case nil
- (progn
- (save-excursion
- (activate-input-method input-method)
- (describe-current-input-method))
- (activate-input-method current))
- (error
- (activate-input-method current)
- (help-setup-xref (list #'describe-input-method input-method)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (let ((elt (assoc input-method input-method-alist)))
- (princ (format-message
- "Input method: %s (`%s' in mode line) for %s\n %s\n"
- input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (and input-method (symbolp input-method))
+ (setq input-method (symbol-name input-method)))
+ (help-setup-xref (list #'describe-input-method
+ (or input-method current-input-method))
+ (called-interactively-p 'interactive))
+
+ (if (null input-method)
+ (describe-current-input-method)
+ (let ((current current-input-method))
+ (condition-case nil
+ (progn
+ (save-excursion
+ (activate-input-method input-method)
+ (describe-current-input-method))
+ (activate-input-method current))
+ (error
+ (activate-input-method current)
+ (help-setup-xref (list #'describe-input-method input-method)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (let ((elt (assoc input-method input-method-alist)))
+ (princ (format-message
+ "Input method: %s (`%s' in mode line) for %s\n %s\n"
+ input-method (nth 3 elt) (nth 1 elt) (nth 4
elt)))))))))))
(defun describe-current-input-method ()
"Describe the input method currently in use.
@@ -2162,89 +2163,90 @@ See `set-language-info-alist' for use in programs."
(list (read-language-name
'documentation
(format-prompt "Describe language environment"
current-language-environment))))
- (if (null language-name)
- (setq language-name current-language-environment))
- (if (or (null language-name)
- (null (get-language-info language-name 'documentation)))
- (error "No documentation for the specified language"))
- (if (symbolp language-name)
- (setq language-name (symbol-name language-name)))
- (dolist (feature (get-language-info language-name 'features))
- (require feature))
- (let ((doc (get-language-info language-name 'documentation)))
- (help-setup-xref (list #'describe-language-environment language-name)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert language-name " language environment\n\n")
- (if (stringp doc)
- (insert (substitute-command-keys doc) "\n\n"))
- (condition-case nil
- (let ((str (eval (get-language-info language-name 'sample-text))))
- (if (stringp str)
- (insert "Sample text:\n "
- (string-replace "\n" "\n " str)
- "\n\n")))
- (error nil))
- (let ((input-method (get-language-info language-name 'input-method))
- (l (copy-sequence input-method-alist))
- (first t))
- (when (and input-method
- (setq input-method (assoc input-method l)))
- (insert "Input methods (default " (car input-method) ")\n")
- (setq l (cons input-method (delete input-method l))
- first nil))
- (dolist (elt l)
- (when (or (eq input-method elt)
- (eq t (compare-strings language-name nil nil
- (nth 1 elt) nil nil t)))
- (when first
- (insert "Input methods:\n")
- (setq first nil))
- (insert " " (car elt))
- (search-backward (car elt))
- (help-xref-button 0 'help-input-method (car elt))
- (goto-char (point-max))
- (insert " (\""
- (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
- "\" in mode line)\n")))
- (or first
- (insert "\n")))
- (insert "Character sets:\n")
- (let ((l (get-language-info language-name 'charset)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-character-set (car l))
- (goto-char (point-max))
- (insert ": " (charset-description (car l)) "\n")
- (setq l (cdr l)))))
- (insert "\n")
- (insert "Coding systems:\n")
- (let ((l (get-language-info language-name 'coding-system)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-coding-system (car l))
- (goto-char (point-max))
- (insert (substitute-command-keys " (`")
- (coding-system-mnemonic (car l))
- (substitute-command-keys "' in mode line):\n\t")
- (substitute-command-keys
- (coding-system-doc-string (car l)))
- "\n")
- (let ((aliases (coding-system-aliases (car l))))
- (when aliases
- (insert "\t(alias:")
- (while aliases
- (insert " " (symbol-name (car aliases)))
- (setq aliases (cdr aliases)))
- (insert ")\n")))
- (setq l (cdr l)))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (null language-name)
+ (setq language-name current-language-environment))
+ (if (or (null language-name)
+ (null (get-language-info language-name 'documentation)))
+ (error "No documentation for the specified language"))
+ (if (symbolp language-name)
+ (setq language-name (symbol-name language-name)))
+ (dolist (feature (get-language-info language-name 'features))
+ (require feature))
+ (let ((doc (get-language-info language-name 'documentation)))
+ (help-setup-xref (list #'describe-language-environment language-name)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert language-name " language environment\n\n")
+ (if (stringp doc)
+ (insert (substitute-command-keys doc) "\n\n"))
+ (condition-case nil
+ (let ((str (eval (get-language-info language-name 'sample-text))))
+ (if (stringp str)
+ (insert "Sample text:\n "
+ (string-replace "\n" "\n " str)
+ "\n\n")))
+ (error nil))
+ (let ((input-method (get-language-info language-name 'input-method))
+ (l (copy-sequence input-method-alist))
+ (first t))
+ (when (and input-method
+ (setq input-method (assoc input-method l)))
+ (insert "Input methods (default " (car input-method) ")\n")
+ (setq l (cons input-method (delete input-method l))
+ first nil))
+ (dolist (elt l)
+ (when (or (eq input-method elt)
+ (eq t (compare-strings language-name nil nil
+ (nth 1 elt) nil nil t)))
+ (when first
+ (insert "Input methods:\n")
+ (setq first nil))
+ (insert " " (car elt))
+ (search-backward (car elt))
+ (help-xref-button 0 'help-input-method (car elt))
+ (goto-char (point-max))
+ (insert " (\""
+ (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
+ "\" in mode line)\n")))
+ (or first
+ (insert "\n")))
+ (insert "Character sets:\n")
+ (let ((l (get-language-info language-name 'charset)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-character-set (car l))
+ (goto-char (point-max))
+ (insert ": " (charset-description (car l)) "\n")
+ (setq l (cdr l)))))
+ (insert "\n")
+ (insert "Coding systems:\n")
+ (let ((l (get-language-info language-name 'coding-system)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-coding-system (car l))
+ (goto-char (point-max))
+ (insert (substitute-command-keys " (`")
+ (coding-system-mnemonic (car l))
+ (substitute-command-keys "' in mode line):\n\t")
+ (substitute-command-keys
+ (coding-system-doc-string (car l)))
+ "\n")
+ (let ((aliases (coding-system-aliases (car l))))
+ (when aliases
+ (insert "\t(alias:")
+ (while aliases
+ (insert " " (symbol-name (car aliases)))
+ (setq aliases (cdr aliases)))
+ (insert ")\n")))
+ (setq l (cdr l))))))))))
;;; Locales.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 5cc73e4..efb9296 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -299,65 +299,66 @@ meanings of these arguments."
(defun describe-character-set (charset)
"Display information about built-in character set CHARSET."
(interactive (list (read-charset "Charset: ")))
- (or (charsetp charset)
- (error "Invalid charset: %S" charset))
- (help-setup-xref (list #'describe-character-set charset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert "Character set: " (symbol-name charset))
- (let ((name (get-charset-property charset :name)))
- (if (not (eq name charset))
- (insert " (alias of " (symbol-name name) ?\))))
- (insert "\n\n" (charset-description charset) "\n\n")
- (insert "Number of contained characters: ")
- (dotimes (i (charset-dimension charset))
- (unless (= i 0)
- (insert ?x))
- (insert (format "%d" (charset-chars charset (1+ i)))))
- (insert ?\n)
- (let ((char (charset-iso-final-char charset)))
- (when (> char 0)
- (insert "Final char of ISO2022 designation sequence: ")
- (insert (format-message "`%c'\n" char))))
- (let (aliases)
- (dolist (c charset-list)
- (if (and (not (eq c charset))
- (eq charset (get-charset-property c :name)))
- (push c aliases)))
- (if aliases
- (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
-
- (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
- (:map "Map file: " identity)
- (:unify-map "Unification map file: " identity)
- (:invalid-code
- nil
- ,(lambda (c)
- (format "Invalid character: %c (code %d)" c c)))
- (:emacs-mule-id "Id in emacs-mule coding system: "
- number-to-string)
- (:parents "Parents: "
- (lambda (parents)
- (mapconcat ,(lambda (elt)
- (format "%s" elt))
- parents
- ", ")))
- (:code-space "Code space: " ,(lambda (c)
- (format "%s" c)))
- (:code-offset "Code offset: " number-to-string)
- (:iso-revision-number "ISO revision number: "
- number-to-string)
- (:supplementary-p
- "Used only as a parent or a subset of some other charset,
+ (let ((help-buffer-under-preparation t))
+ (or (charsetp charset)
+ (error "Invalid charset: %S" charset))
+ (help-setup-xref (list #'describe-character-set charset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert "Character set: " (symbol-name charset))
+ (let ((name (get-charset-property charset :name)))
+ (if (not (eq name charset))
+ (insert " (alias of " (symbol-name name) ?\))))
+ (insert "\n\n" (charset-description charset) "\n\n")
+ (insert "Number of contained characters: ")
+ (dotimes (i (charset-dimension charset))
+ (unless (= i 0)
+ (insert ?x))
+ (insert (format "%d" (charset-chars charset (1+ i)))))
+ (insert ?\n)
+ (let ((char (charset-iso-final-char charset)))
+ (when (> char 0)
+ (insert "Final char of ISO2022 designation sequence: ")
+ (insert (format-message "`%c'\n" char))))
+ (let (aliases)
+ (dolist (c charset-list)
+ (if (and (not (eq c charset))
+ (eq charset (get-charset-property c :name)))
+ (push c aliases)))
+ (if aliases
+ (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
+
+ (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
+ (:map "Map file: " identity)
+ (:unify-map "Unification map file: " identity)
+ (:invalid-code
+ nil
+ ,(lambda (c)
+ (format "Invalid character: %c (code %d)" c c)))
+ (:emacs-mule-id "Id in emacs-mule coding system: "
+ number-to-string)
+ (:parents "Parents: "
+ (lambda (parents)
+ (mapconcat ,(lambda (elt)
+ (format "%s" elt))
+ parents
+ ", ")))
+ (:code-space "Code space: " ,(lambda (c)
+ (format "%s" c)))
+ (:code-offset "Code offset: " number-to-string)
+ (:iso-revision-number "ISO revision number: "
+ number-to-string)
+ (:supplementary-p
+ "Used only as a parent or a subset of some other
charset,
or provided just for backward compatibility." nil)))
- (let ((val (get-charset-property charset (car elt))))
- (when val
- (if (cadr elt) (insert (cadr elt)))
- (if (nth 2 elt)
- (let ((print-length 10) (print-level 2))
- (princ (funcall (nth 2 elt) val) (current-buffer))))
- (insert ?\n)))))))
+ (let ((val (get-charset-property charset (car elt))))
+ (when val
+ (if (cadr elt) (insert (cadr elt)))
+ (if (nth 2 elt)
+ (let ((print-length 10) (print-level 2))
+ (princ (funcall (nth 2 elt) val) (current-buffer))))
+ (insert ?\n))))))))
;;; CODING-SYSTEM
@@ -406,89 +407,90 @@ or provided just for backward compatibility." nil)))
(defun describe-coding-system (coding-system)
"Display information about CODING-SYSTEM."
(interactive "zDescribe coding system (default current choices): ")
- (if (null coding-system)
- (describe-current-coding-system)
- (help-setup-xref (list #'describe-coding-system coding-system)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (print-coding-system-briefly coding-system 'doc-string)
- (let ((type (coding-system-type coding-system))
- ;; Fixme: use this
- ;; (extra-spec (coding-system-plist coding-system))
- )
- (princ "Type: ")
- (princ type)
- (cond ((eq type 'undecided)
- (princ " (do automatic conversion)"))
- ((eq type 'utf-8)
- (princ " (UTF-8: Emacs internal multibyte form)"))
- ((eq type 'utf-16)
- ;; (princ " (UTF-16)")
- )
- ((eq type 'shift-jis)
- (princ " (Shift-JIS, MS-KANJI)"))
- ((eq type 'iso-2022)
- (princ " (variant of ISO-2022)\n")
- (princ "Initial designations:\n")
- (print-designation (coding-system-get coding-system
- :designation))
-
- (when (coding-system-get coding-system :flags)
- (princ "Other specifications: \n ")
- (apply #'print-list
- (coding-system-get coding-system :flags))))
- ((eq type 'charset)
- (princ " (charset)"))
- ((eq type 'ccl)
- (princ " (do conversion by CCL program)"))
- ((eq type 'raw-text)
- (princ " (text with random binary characters)"))
- ((eq type 'emacs-mule)
- (princ " (Emacs 21 internal encoding)"))
- ((eq type 'big5))
- (t (princ ": invalid coding-system.")))
- (princ "\nEOL type: ")
- (let ((eol-type (coding-system-eol-type coding-system)))
- (cond ((vectorp eol-type)
- (princ "Automatic selection from:\n\t")
- (princ eol-type)
- (princ "\n"))
- ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
- ((eq eol-type 1) (princ "CRLF\n"))
- ((eq eol-type 2) (princ "CR\n"))
- (t (princ "invalid\n")))))
- (let ((postread (coding-system-get coding-system :post-read-conversion)))
- (when postread
- (princ "After decoding text normally,")
- (princ " perform post-conversion using the function: ")
- (princ "\n ")
- (princ postread)
- (princ "\n")))
- (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
- (when prewrite
- (princ "Before encoding text normally,")
- (princ " perform pre-conversion using the function: ")
- (princ "\n ")
- (princ prewrite)
- (princ "\n")))
- (with-current-buffer standard-output
- (let ((charsets (coding-system-charset-list coding-system)))
- (when (and (not (eq (coding-system-base coding-system) 'raw-text))
- charsets)
- (cond
- ((eq charsets 'iso-2022)
- (insert "This coding system can encode all ISO 2022 charsets."))
- ((eq charsets 'emacs-mule)
- (insert "This coding system can encode all emacs-mule charsets\
+ (let ((help-buffer-under-preparation t))
+ (if (null coding-system)
+ (describe-current-coding-system)
+ (help-setup-xref (list #'describe-coding-system coding-system)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (print-coding-system-briefly coding-system 'doc-string)
+ (let ((type (coding-system-type coding-system))
+ ;; Fixme: use this
+ ;; (extra-spec (coding-system-plist coding-system))
+ )
+ (princ "Type: ")
+ (princ type)
+ (cond ((eq type 'undecided)
+ (princ " (do automatic conversion)"))
+ ((eq type 'utf-8)
+ (princ " (UTF-8: Emacs internal multibyte form)"))
+ ((eq type 'utf-16)
+ ;; (princ " (UTF-16)")
+ )
+ ((eq type 'shift-jis)
+ (princ " (Shift-JIS, MS-KANJI)"))
+ ((eq type 'iso-2022)
+ (princ " (variant of ISO-2022)\n")
+ (princ "Initial designations:\n")
+ (print-designation (coding-system-get coding-system
+ :designation))
+
+ (when (coding-system-get coding-system :flags)
+ (princ "Other specifications: \n ")
+ (apply #'print-list
+ (coding-system-get coding-system :flags))))
+ ((eq type 'charset)
+ (princ " (charset)"))
+ ((eq type 'ccl)
+ (princ " (do conversion by CCL program)"))
+ ((eq type 'raw-text)
+ (princ " (text with random binary characters)"))
+ ((eq type 'emacs-mule)
+ (princ " (Emacs 21 internal encoding)"))
+ ((eq type 'big5))
+ (t (princ ": invalid coding-system.")))
+ (princ "\nEOL type: ")
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (cond ((vectorp eol-type)
+ (princ "Automatic selection from:\n\t")
+ (princ eol-type)
+ (princ "\n"))
+ ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
+ ((eq eol-type 1) (princ "CRLF\n"))
+ ((eq eol-type 2) (princ "CR\n"))
+ (t (princ "invalid\n")))))
+ (let ((postread (coding-system-get coding-system
:post-read-conversion)))
+ (when postread
+ (princ "After decoding text normally,")
+ (princ " perform post-conversion using the function: ")
+ (princ "\n ")
+ (princ postread)
+ (princ "\n")))
+ (let ((prewrite (coding-system-get coding-system
:pre-write-conversion)))
+ (when prewrite
+ (princ "Before encoding text normally,")
+ (princ " perform pre-conversion using the function: ")
+ (princ "\n ")
+ (princ prewrite)
+ (princ "\n")))
+ (with-current-buffer standard-output
+ (let ((charsets (coding-system-charset-list coding-system)))
+ (when (and (not (eq (coding-system-base coding-system) 'raw-text))
+ charsets)
+ (cond
+ ((eq charsets 'iso-2022)
+ (insert "This coding system can encode all ISO 2022 charsets."))
+ ((eq charsets 'emacs-mule)
+ (insert "This coding system can encode all emacs-mule charsets\
."""))
- (t
- (insert "This coding system encodes the following charsets:\n ")
- (while charsets
- (insert " " (symbol-name (car charsets)))
- (search-backward (symbol-name (car charsets)))
- (help-xref-button 0 'help-character-set (car charsets))
- (goto-char (point-max))
- (setq charsets (cdr charsets)))))))))))
+ (t
+ (insert "This coding system encodes the following charsets:\n ")
+ (while charsets
+ (insert " " (symbol-name (car charsets)))
+ (search-backward (symbol-name (car charsets)))
+ (help-xref-button 0 'help-character-set (car charsets))
+ (goto-char (point-max))
+ (setq charsets (cdr charsets))))))))))))
;;;###autoload
(defun describe-current-coding-system-briefly ()
@@ -845,7 +847,8 @@ The IGNORED argument is ignored."
(or (and window-system (fboundp 'fontset-list))
(error "No fonts being used"))
(let ((xref-item (list #'describe-font fontname))
- font-info)
+ font-info
+ (help-buffer-under-preparation t))
(if (or (not fontname) (= (length fontname) 0))
(setq fontname (face-attribute 'default :font)))
(setq font-info (font-info fontname))
@@ -1006,14 +1009,15 @@ This shows which font is used for which character(s)."
(list (completing-read
(format-prompt "Fontset" "used by the current frame")
fontset-list nil t)))))
- (if (= (length fontset) 0)
- (setq fontset (face-attribute 'default :fontset))
- (setq fontset (query-fontset fontset)))
- (help-setup-xref (list #'describe-fontset fontset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (print-fontset fontset t))))
+ (let ((help-buffer-under-preparation t))
+ (if (= (length fontset) 0)
+ (setq fontset (face-attribute 'default :fontset))
+ (setq fontset (query-fontset fontset)))
+ (help-setup-xref (list #'describe-fontset fontset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (print-fontset fontset t)))))
(declare-function fontset-plain-name "fontset" (fontset))
@@ -1024,39 +1028,41 @@ This shows the name, size, and style of each fontset.
With prefix arg, also list the fonts contained in each fontset;
see the function `describe-fontset' for the format of the list."
(interactive "P")
- (if (not (and window-system (fboundp 'fontset-list)))
- (error "No fontsets being used")
- (help-setup-xref (list #'list-fontsets arg)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- ;; This code is duplicated near the end of mule-diag.
- (let ((fontsets
- (sort (fontset-list)
- (lambda (x y)
- (string< (fontset-plain-name x)
- (fontset-plain-name y))))))
- (while fontsets
- (if arg
- (print-fontset (car fontsets) nil)
- (insert "Fontset: " (car fontsets) "\n"))
- (setq fontsets (cdr fontsets))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (and window-system (fboundp 'fontset-list)))
+ (error "No fontsets being used")
+ (help-setup-xref (list #'list-fontsets arg)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ ;; This code is duplicated near the end of mule-diag.
+ (let ((fontsets
+ (sort (fontset-list)
+ (lambda (x y)
+ (string< (fontset-plain-name x)
+ (fontset-plain-name y))))))
+ (while fontsets
+ (if arg
+ (print-fontset (car fontsets) nil)
+ (insert "Fontset: " (car fontsets) "\n"))
+ (setq fontsets (cdr fontsets)))))))))
;;;###autoload
(defun list-input-methods ()
"Display information about all input methods."
(interactive)
- (help-setup-xref '(list-input-methods)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (list-input-methods-1)
- (with-current-buffer standard-output
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode line)$")
- nil t)
- (help-xref-button 1 'help-input-method (match-string 1)))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref '(list-input-methods)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (list-input-methods-1)
+ (with-current-buffer standard-output
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode
line)$")
+ nil t)
+ (help-xref-button 1 'help-input-method (match-string 1))))))))
(defun list-input-methods-1 ()
(if (not input-method-alist)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 32ffb18..7bbb398 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -515,31 +515,32 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
Used in `repeat-mode'."
(interactive)
(require 'help-fns)
- (help-setup-xref (list #'describe-repeat-maps)
- (called-interactively-p 'interactive))
- (let ((keymaps nil))
- (all-completions
- "" obarray (lambda (s)
- (and (commandp s)
- (get s 'repeat-map)
- (push s (alist-get (get s 'repeat-map) keymaps)))))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (princ "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
-
- (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car
b)))))
- (princ (format-message "`%s' keymap is repeatable by these
commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) 'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (symbol-value (car keymap))))
- (desc (mapconcat (lambda (key)
- (format-message "`%s'" (key-description
key)))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (princ (format-message " `%s' (bound to %s)\n" command desc))))
- (princ "\n"))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-repeat-maps)
+ (called-interactively-p 'interactive))
+ (let ((keymaps nil))
+ (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push s (alist-get (get s 'repeat-map) keymaps)))))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (princ "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
+
+ (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a)
(car b)))))
+ (princ (format-message "`%s' keymap is repeatable by these
commands:\n"
+ (car keymap)))
+ (dolist (command (sort (cdr keymap) 'string-lessp))
+ (let* ((info (help-fns--analyze-function command))
+ (map (list (symbol-value (car keymap))))
+ (desc (mapconcat (lambda (key)
+ (format-message "`%s'"
(key-description key)))
+ (or (where-is-internal command map)
+ (where-is-internal (nth 3 info) map))
+ ", ")))
+ (princ (format-message " `%s' (bound to %s)\n" command desc))))
+ (princ "\n")))))))
(provide 'repeat)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 49422d2: Do not buttonize key bindings outside of *Help* buffers,
Lars Ingebrigtsen <=