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.
This commit is contained in:
parent
d8dd705e9d
commit
49422d2e69
9 changed files with 670 additions and 637 deletions
3
etc/NEWS
3
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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
549
lisp/help-fns.el
549
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))
|
||||
|
|
|
@ -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)
|
||||
|
|
107
lisp/help.el
107
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)
|
||||
(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))))))))
|
||||
(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)
|
||||
|
|
|
@ -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))
|
||||
(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))))))))))
|
||||
(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.
|
||||
|
||||
|
|
|
@ -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)))
|
||||
(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,
|
||||
(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))
|
||||
(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\
|
||||
(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)
|
||||
|
|
|
@ -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")
|
||||
(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"))))))
|
||||
(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)
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue