* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
[not found] <87czmr5gr7.fsf.ref@yahoo.com>
@ 2021-11-23 10:05 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 6:17 ` Phil Sainty
` (2 more replies)
0 siblings, 3 replies; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-23 10:05 UTC (permalink / raw)
To: 52053
Start emacs with `emacs -Q', and click on the "C-x C-f" in the initial
scratch message. You will get this nonsensical error:
Debugger entered--Lisp error: (error "Current buffer is not in Help mode")
signal(error ("Current buffer is not in Help mode"))
error("Current buffer is not in Help mode")
help-buffer()
help-setup-xref((#f(compiled-function #'buffer #<bytecode -0x1c5aa85c15071043>) find-file #<buffer *scratch*>) nil)
describe-function(find-file)
I also don't understand why it makes sense to have a button there.
Thanks.
In GNU Emacs 29.0.50 (build 290, x86_64-pc-linux-gnu, GTK+ Version 3.24.30, cairo version 1.17.4)
of 2021-11-23 built on trinity
Repository revision: 5c4136f56465c6b2c65fb3577603879cdbbe7f97
Repository branch: x-window-xwidget
Windowing system distributor 'The X.Org Foundation', version 11.0.12101003
System Description: Fedora Linux 35 (Workstation Edition)
Configured using:
'configure'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON
LCMS2 LIBSELINUX LIBSYSTEMD LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG
RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM
XPM XWIDGETS GTK3 ZLIB
Important settings:
value of $LANG: en_GB.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media rmc puny
dired dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068
epg-config gnus-util rmail rmail-loaddefs auth-source cl-seq eieio
eieio-core cl-macs eieio-loaddefs password-cache json map
text-property-search seq gv byte-opt bytecomp byte-compile cconv
mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils
mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr
mail-utils help-fns radix-tree time-date subr-x help-mode cl-loaddefs
cl-lib iso-transl tooltip eldoc paren electric uniquify ediff-hook
vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode lisp-mode prog-mode register
page tab-bar menu-bar rfn-eshadow isearch easymenu timer select
scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors
frame minibuffer cl-generic cham georgian utf-8-lang misc-lang
vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932
hebrew greek romanian slovak czech european ethiopic indian cyrillic
chinese composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice button
loaddefs faces cus-face macroexp files window text-properties overlay
sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads xwidget-internal dbusbind
inotify lcms2 dynamic-setting system-font-setting font-render-setting
cairo move-toolbar gtk x-toolkit x multi-tty make-network-process emacs)
Memory information:
((conses 16 56631 6540)
(symbols 48 6880 1)
(strings 32 22129 1214)
(string-bytes 1 717211)
(vectors 16 14316)
(vector-slots 8 191056 8952)
(floats 8 23 55)
(intervals 56 201 0)
(buffers 992 10))
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-23 10:05 ` bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-24 6:17 ` Phil Sainty
2021-11-24 7:53 ` Lars Ingebrigtsen
2021-11-25 10:23 ` Gregory Heytings
2 siblings, 0 replies; 37+ messages in thread
From: Phil Sainty @ 2021-11-24 6:17 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
On 2021-11-23 23:05, Po Lu wrote:
> Start emacs with `emacs -Q', and click on the "C-x C-f" in the initial
> scratch message. You will get this nonsensical error:
>
> Debugger entered--Lisp error: (error "Current buffer is not in Help
> mode")
Bug #41836 is related to this.
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=41836
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-23 10:05 ` bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 6:17 ` Phil Sainty
@ 2021-11-24 7:53 ` Lars Ingebrigtsen
2021-11-24 9:28 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-25 10:23 ` Gregory Heytings
2 siblings, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-24 7:53 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
> Start emacs with `emacs -Q', and click on the "C-x C-f" in the initial
> scratch message. You will get this nonsensical error:
>
> Debugger entered--Lisp error: (error "Current buffer is not in Help mode")
> signal(error ("Current buffer is not in Help mode"))
> error("Current buffer is not in Help mode")
> help-buffer()
> help-setup-xref((#f(compiled-function #'buffer #<bytecode -0x1c5aa85c15071043>) find-file #<buffer *scratch*>) nil)
> describe-function(find-file)
>
> I also don't understand why it makes sense to have a button there.
I don't think we're meant to have a button here, but we're running this:
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with \\[find-file] and enter text in its buffer.
")
through substitute-command-keys so that the find-file is expanded.
The problem is two-fold: substitute-command-keys shouldn't buttonise the
keys here, so perhaps it should grow a new parameter to inhibit that.
The other problem is that the font-locking in the buffer removes the
nice fontification of the key binding, so that should also be fixed.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 7:53 ` Lars Ingebrigtsen
@ 2021-11-24 9:28 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 10:58 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-24 9:28 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
> I don't think we're meant to have a button here, but we're running this:
>
> (defcustom initial-scratch-message (purecopy "\
> ;; This buffer is for text that is not saved, and for Lisp evaluation.
> ;; To create a file, visit it with \\[find-file] and enter text in its buffer.
>
> ")
>
> through substitute-command-keys so that the find-file is expanded.
>
> The problem is two-fold: substitute-command-keys shouldn't buttonise the
> keys here, so perhaps it should grow a new parameter to inhibit that.
>
> The other problem is that the font-locking in the buffer removes the
> nice fontification of the key binding, so that should also be fixed.
FWIW, I don't think it makes sense to fontify key bindings specially in
lisp-interaction-mode. I expect to see only the comment face there.
Thanks.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 9:28 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-24 10:58 ` Lars Ingebrigtsen
2021-11-24 11:15 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-24 10:58 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
> FWIW, I don't think it makes sense to fontify key bindings specially in
> lisp-interaction-mode. I expect to see only the comment face there.
We should fontify key bindings the same everywhere (that a user could be
seeing them), I think.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 10:58 ` Lars Ingebrigtsen
@ 2021-11-24 11:15 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 11:27 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-24 11:15 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
>> FWIW, I don't think it makes sense to fontify key bindings specially in
>> lisp-interaction-mode. I expect to see only the comment face there.
> We should fontify key bindings the same everywhere (that a user could be
> seeing them), I think.
Does that include inside comments in Lisp code?
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 11:15 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-24 11:27 ` Lars Ingebrigtsen
2021-11-24 11:36 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-24 11:27 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
>> We should fontify key bindings the same everywhere (that a user could be
>> seeing them), I think.
>
> Does that include inside comments in Lisp code?
Probably not -- that's not something that's for the user to peruse. But
perhaps it should?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 11:27 ` Lars Ingebrigtsen
@ 2021-11-24 11:36 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 16:39 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-24 11:36 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
>> Does that include inside comments in Lisp code?
> Probably not -- that's not something that's for the user to peruse. But
> perhaps it should?
I don't think it should, and similarly, it shouldn't apply to
lisp-interaction-mode, which is simply Emacs Lisp mode but slightly more
interactive.
Thanks.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 11:36 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-24 16:39 ` Lars Ingebrigtsen
2021-11-24 17:05 ` Andreas Schwab
2021-11-25 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 2 replies; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-24 16:39 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
> I don't think it should, and similarly, it shouldn't apply to
> lisp-interaction-mode, which is simply Emacs Lisp mode but slightly more
> interactive.
Sure, but that ;; comment there is put there explicitly as a message to
the user.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 16:39 ` Lars Ingebrigtsen
@ 2021-11-24 17:05 ` Andreas Schwab
2021-11-25 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 0 replies; 37+ messages in thread
From: Andreas Schwab @ 2021-11-24 17:05 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: Po Lu, 52053
On Nov 24 2021, Lars Ingebrigtsen wrote:
> Po Lu <luangruo@yahoo.com> writes:
>
>> I don't think it should, and similarly, it shouldn't apply to
>> lisp-interaction-mode, which is simply Emacs Lisp mode but slightly more
>> interactive.
>
> Sure, but that ;; comment there is put there explicitly as a message to
> the user.
Then it should probably get some special property.
Andreas.
--
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 7578 EB47 D4E5 4D69 2510 2552 DF73 E780 A9DA AEC1
"And now for something completely different."
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-24 16:39 ` Lars Ingebrigtsen
2021-11-24 17:05 ` Andreas Schwab
@ 2021-11-25 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-25 13:34 ` Lars Ingebrigtsen
1 sibling, 1 reply; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-25 0:45 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
>> I don't think it should, and similarly, it shouldn't apply to
>> lisp-interaction-mode, which is simply Emacs Lisp mode but slightly more
>> interactive.
> Sure, but that ;; comment there is put there explicitly as a message to
> the user.
We could make it something like the explanations for novice users in
`report-emacs-bug'. It needn't be a comment.
Thanks.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-23 10:05 ` bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 6:17 ` Phil Sainty
2021-11-24 7:53 ` Lars Ingebrigtsen
@ 2021-11-25 10:23 ` Gregory Heytings
2021-11-25 10:59 ` Eli Zaretskii
2 siblings, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-25 10:23 UTC (permalink / raw)
To: Po Lu; +Cc: Lars Ingebrigtsen, 52053
[-- Attachment #1: Type: text/plain, Size: 16 bytes --]
Patch attached.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff; name=Do-not-buttonize-key-bindings-outside-of-Help-buffer.patch, Size: 1770 bytes --]
From f0e44fc134ada890473769e80770e70e64ab11a1 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Thu, 25 Nov 2021 10:19:32 +0000
Subject: [PATCH] Do not buttonize key bindings outside of *Help* buffers
* lisp/help.el (substitute-command-keys): help-link-key-to-documentation
is supposed to have an effect only "in *Help* buffers". Detect whether
the output will go in a *Help* buffer, and if not, do not buttonize the
key binding. Fixes bug#52053.
---
lisp/help.el | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/lisp/help.el b/lisp/help.el
index bc3d4773da..2e21060d35 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1105,7 +1105,9 @@ substitute-command-keys
;; itself.
(let ((keymap overriding-local-map)
(inhibit-modification-hooks t)
- (orig-buf (current-buffer)))
+ (orig-buf (current-buffer))
+ (in-help (eq (car temp-buffer-window-setup-hook)
+ 'help-mode-setup)))
(with-temp-buffer
(insert string)
(goto-char (point-min))
@@ -1161,7 +1163,8 @@ substitute-command-keys
(delete-char (- end-point (point)))
(let ((key (help--key-description-fontified key)))
(insert (if (and help-link-key-to-documentation
- (functionp fun))
+ (functionp fun)
+ in-help)
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
(help-mode--add-function-link key fun)
--
2.33.0
^ permalink raw reply related [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 10:23 ` Gregory Heytings
@ 2021-11-25 10:59 ` Eli Zaretskii
2021-11-25 11:07 ` Gregory Heytings
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-25 10:59 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, larsi, 52053
> Date: Thu, 25 Nov 2021 10:23:38 +0000
> From: Gregory Heytings <gregory@heytings.org>
> Cc: Lars Ingebrigtsen <larsi@gnus.org>, 52053@debbugs.gnu.org
>
> --- a/lisp/help.el
> +++ b/lisp/help.el
> @@ -1105,7 +1105,9 @@ substitute-command-keys
> ;; itself.
> (let ((keymap overriding-local-map)
> (inhibit-modification-hooks t)
> - (orig-buf (current-buffer)))
> + (orig-buf (current-buffer))
> + (in-help (eq (car temp-buffer-window-setup-hook)
> + 'help-mode-setup)))
Thanks, but I'd prefer a less obscure way of telling whether this
is going into *Help* buffers. Is this really the only way? Or maybe
the mouse-face etc. should not be put as part of
substitute-command-keys, but by the Help mode itself, when the text is
already in the *Help* buffer? As we use substitute-command-keys more
and more, these problems will probably pop up more and more, so maybe
we should rethink whether this part is really something it should do.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 10:59 ` Eli Zaretskii
@ 2021-11-25 11:07 ` Gregory Heytings
2021-11-25 11:21 ` Eli Zaretskii
0 siblings, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-25 11:07 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
>
> Thanks, but I'd prefer a less obscure way of telling whether this is
> going into *Help* buffers. Is this really the only way?
>
I agree with you that it's a bit obscure, and I tried to find a better
way, but couldn't. Someone else might have a better idea. I think
another possible way would be to query this-command:
(in-help (or (eq major-mode 'help-mode)
(and this-command
(where-is-internal this-command help-map t))))
But somehow I find this even less elegant, and I'm less certain about its
correctness.
>
> Or maybe the mouse-face etc. should not be put as part of
> substitute-command-keys, but by the Help mode itself, when the text is
> already in the *Help* buffer? As we use substitute-command-keys more
> and more, these problems will probably pop up more and more, so maybe we
> should rethink whether this part is really something it should do.
>
With this patch it shouldn't happen outside of Help mode anymore.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 11:07 ` Gregory Heytings
@ 2021-11-25 11:21 ` Eli Zaretskii
2021-11-25 12:47 ` Robert Pluim
2021-11-25 13:41 ` Gregory Heytings
0 siblings, 2 replies; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-25 11:21 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, larsi, 52053
> Date: Thu, 25 Nov 2021 11:07:44 +0000
> From: Gregory Heytings <gregory@heytings.org>
> cc: luangruo@yahoo.com, larsi@gnus.org, 52053@debbugs.gnu.org
>
> > Thanks, but I'd prefer a less obscure way of telling whether this is
> > going into *Help* buffers. Is this really the only way?
>
> I agree with you that it's a bit obscure, and I tried to find a better
> way, but couldn't. Someone else might have a better idea. I think
> another possible way would be to query this-command:
>
> (in-help (or (eq major-mode 'help-mode)
> (and this-command
> (where-is-internal this-command help-map t))))
>
> But somehow I find this even less elegant, and I'm less certain about its
> correctness.
It's definitely not more elegant, agreed.
I do hope a better idea emerges. Anybody?
> > Or maybe the mouse-face etc. should not be put as part of
> > substitute-command-keys, but by the Help mode itself, when the text is
> > already in the *Help* buffer? As we use substitute-command-keys more
> > and more, these problems will probably pop up more and more, so maybe we
> > should rethink whether this part is really something it should do.
> >
>
> With this patch it shouldn't happen outside of Help mode anymore.
Yes, but that's somewhat blunt a weapon, I think. My idea was to
maybe let the caller decide whether this is wanted or not, if we are
going to use substitute-command-keys in way more contexts than it was
originally meant to.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 11:21 ` Eli Zaretskii
@ 2021-11-25 12:47 ` Robert Pluim
2021-11-25 13:20 ` Eli Zaretskii
2021-11-25 13:41 ` Gregory Heytings
1 sibling, 1 reply; 37+ messages in thread
From: Robert Pluim @ 2021-11-25 12:47 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, Gregory Heytings, 52053, larsi
>>>>> On Thu, 25 Nov 2021 13:21:02 +0200, Eli Zaretskii <eliz@gnu.org> said:
Eli> Yes, but that's somewhat blunt a weapon, I think. My idea was to
Eli> maybe let the caller decide whether this is wanted or not, if we are
Eli> going to use substitute-command-keys in way more contexts than it was
Eli> originally meant to.
Callers can just bind help-link-key-to-documentation to nil, no? What
am I missing>
Robert
--
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 12:47 ` Robert Pluim
@ 2021-11-25 13:20 ` Eli Zaretskii
2021-11-25 13:36 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-25 13:20 UTC (permalink / raw)
To: Robert Pluim; +Cc: luangruo, gregory, 52053, larsi
> From: Robert Pluim <rpluim@gmail.com>
> Cc: Gregory Heytings <gregory@heytings.org>, luangruo@yahoo.com,
> larsi@gnus.org, 52053@debbugs.gnu.org
> Date: Thu, 25 Nov 2021 13:47:36 +0100
>
> >>>>> On Thu, 25 Nov 2021 13:21:02 +0200, Eli Zaretskii <eliz@gnu.org> said:
>
> Eli> Yes, but that's somewhat blunt a weapon, I think. My idea was to
> Eli> maybe let the caller decide whether this is wanted or not, if we are
> Eli> going to use substitute-command-keys in way more contexts than it was
> Eli> originally meant to.
>
> Callers can just bind help-link-key-to-documentation to nil, no? What
> am I missing>
Maybe we should make it nil by default and have Help commands bind it
to non-nil.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-25 13:34 ` Lars Ingebrigtsen
2021-11-26 0:38 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-25 13:34 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
> We could make it something like the explanations for novice users in
> `report-emacs-bug'. It needn't be a comment.
The nice thing about it being a comment is that you can still say `M-x
eval-buffer' without it getting in the way.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 13:20 ` Eli Zaretskii
@ 2021-11-25 13:36 ` Lars Ingebrigtsen
0 siblings, 0 replies; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-25 13:36 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, Robert Pluim, 52053, gregory
Eli Zaretskii <eliz@gnu.org> writes:
> Maybe we should make it nil by default and have Help commands bind it
> to non-nil.
Sounds like a good solution to me.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 11:21 ` Eli Zaretskii
2021-11-25 12:47 ` Robert Pluim
@ 2021-11-25 13:41 ` Gregory Heytings
2021-11-25 14:16 ` Eli Zaretskii
1 sibling, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-25 13:41 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
>
> Yes, but that's somewhat blunt a weapon, I think. My idea was to maybe
> let the caller decide whether this is wanted or not, if we are going to
> use substitute-command-keys in way more contexts than it was originally
> meant to.
>
AFAICS, the options are:
1. Detect inside substitute-command-keys whether the string is for a
*Help* buffer. That's what the patch does, it's the simplest solution
from the point of view of those who call s-c-k.
2. Add an optional parameter to s-c-k to indicate whether the string is
for a non-*Help* buffer. That's a reasonable alternative, but there are
~450 calls to s-c-k in the trunk, each would have to be checked.
3. Add a variable and let-bind it around the calls to s-c-k to indicate
when the string is for a non-*Help* buffer.
4. Let-bind help-link-key-to-documentation to nil around the calls to
s-c-k to indicate that the calls to help-mode--add-function-link should be
skipped. ISTM that this is not generic enough, if in six months we had
another similar feature it would be necessary to let-bind two variables
around calls for non-*Help* buffers, and so forth.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 13:41 ` Gregory Heytings
@ 2021-11-25 14:16 ` Eli Zaretskii
2021-11-25 14:55 ` Gregory Heytings
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-25 14:16 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, larsi, 52053
> Date: Thu, 25 Nov 2021 13:41:50 +0000
> From: Gregory Heytings <gregory@heytings.org>
> cc: luangruo@yahoo.com, larsi@gnus.org, 52053@debbugs.gnu.org
>
> AFAICS, the options are:
>
> 1. Detect inside substitute-command-keys whether the string is for a
> *Help* buffer. That's what the patch does, it's the simplest solution
> from the point of view of those who call s-c-k.
>
> 2. Add an optional parameter to s-c-k to indicate whether the string is
> for a non-*Help* buffer. That's a reasonable alternative, but there are
> ~450 calls to s-c-k in the trunk, each would have to be checked.
>
> 3. Add a variable and let-bind it around the calls to s-c-k to indicate
> when the string is for a non-*Help* buffer.
>
> 4. Let-bind help-link-key-to-documentation to nil around the calls to
> s-c-k to indicate that the calls to help-mode--add-function-link should be
> skipped. ISTM that this is not generic enough, if in six months we had
> another similar feature it would be necessary to let-bind two variables
> around calls for non-*Help* buffers, and so forth.
I think the best solution is to change the default value of
help-link-key-to-documentation to be nil, and then bind it to non-nil
in Help commands.
I'm not sure I understand what additional feature you have in mind and
how such an additional feature could be related to this discussion.
So please elaborate on that part.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 14:16 ` Eli Zaretskii
@ 2021-11-25 14:55 ` Gregory Heytings
2021-11-25 15:15 ` Eli Zaretskii
0 siblings, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-25 14:55 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
>> 4. Let-bind help-link-key-to-documentation to nil around the calls to
>> s-c-k to indicate that the calls to help-mode--add-function-link should
>> be skipped. ISTM that this is not generic enough, if in six months we
>> had another similar feature it would be necessary to let-bind two
>> variables around calls for non-*Help* buffers, and so forth.
>
> I think the best solution is to change the default value of
> help-link-key-to-documentation to be nil, and then bind it to non-nil in
> Help commands.
>
> I'm not sure I understand what additional feature you have in mind and
> how such an additional feature could be related to this discussion. So
> please elaborate on that part.
>
I have no idea what that feature could be, but the
help-link-key-to-documentation feature was added a month ago, and
substitute-command-key is rather complex, so I can very well imagine that
a new help-frobnicate feature could be added in a not too far future.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 14:55 ` Gregory Heytings
@ 2021-11-25 15:15 ` Eli Zaretskii
2021-11-25 22:45 ` Gregory Heytings
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-25 15:15 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, larsi, 52053
> Date: Thu, 25 Nov 2021 14:55:15 +0000
> From: Gregory Heytings <gregory@heytings.org>
> cc: luangruo@yahoo.com, larsi@gnus.org, 52053@debbugs.gnu.org
>
>
> >> 4. Let-bind help-link-key-to-documentation to nil around the calls to
> >> s-c-k to indicate that the calls to help-mode--add-function-link should
> >> be skipped. ISTM that this is not generic enough, if in six months we
> >> had another similar feature it would be necessary to let-bind two
> >> variables around calls for non-*Help* buffers, and so forth.
> >
> > I think the best solution is to change the default value of
> > help-link-key-to-documentation to be nil, and then bind it to non-nil in
> > Help commands.
> >
> > I'm not sure I understand what additional feature you have in mind and
> > how such an additional feature could be related to this discussion. So
> > please elaborate on that part.
> >
>
> I have no idea what that feature could be, but the
> help-link-key-to-documentation feature was added a month ago, and
> substitute-command-key is rather complex, so I can very well imagine that
> a new help-frobnicate feature could be added in a not too far future.
At which point we will either make it dependent on the same variable,
or maybe rename the variable if its name no longer fits what it
controls.
Would that resolve the issue?
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 15:15 ` Eli Zaretskii
@ 2021-11-25 22:45 ` Gregory Heytings
2021-11-26 6:26 ` Eli Zaretskii
0 siblings, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-25 22:45 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
[-- Attachment #1: Type: text/plain, Size: 24 bytes --]
Updated patch attached.
[-- Attachment #2: Type: text/x-diff, Size: 4273 bytes --]
From 7098a09b3d1d53e2a0c50f57d92fc397a65b4e39 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Thu, 25 Nov 2021 22:37:37 +0000
Subject: [PATCH] Do not buttonize key bindings outside of *Help* buffers
* lisp/help.el (substitute-command-keys--in-help): New variable to
differentiate calls to substitute-command-keys in *Help* buffers from
other calls.
(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.
(describe-key): Use the new variable.
* lisp/help-fns.el (describe-function, describe-variable,
describe-symbol): Use the new variable.
* lisp/help-macro.el (make-help-screen): Use the new variable.
---
lisp/help-fns.el | 9 ++++++---
lisp/help-macro.el | 3 ++-
lisp/help.el | 7 ++++++-
3 files changed, 14 insertions(+), 5 deletions(-)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 17fabe4f63..a018cc293b 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -249,7 +249,8 @@ describe-function
;; calling that.
(let ((describe-function-orig-buffer
(or describe-function-orig-buffer
- (current-buffer))))
+ (current-buffer)))
+ (substitute-command-keys--in-help t))
(help-setup-xref
(list (lambda (function buffer)
@@ -1085,7 +1086,8 @@ describe-variable
(user-error "You didn't specify a variable")
(save-excursion
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- val val-start-pos locus)
+ val val-start-pos locus
+ (substitute-command-keys--in-help t))
;; Extract the value before setting up the output buffer,
;; in case `buffer' *is* the output buffer.
(unless valvoid
@@ -1619,7 +1621,8 @@ describe-symbol
(cons name
(funcall descfn symbol buffer frame))))
describe-symbol-backends))))
- (single (null (cdr docs))))
+ (single (null (cdr docs)))
+ (substitute-command-keys--in-help t))
(while (cdr docs)
(goto-char (point-min))
(let ((inhibit-read-only t)
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 588efee66b..25f6b3ba46 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -93,7 +93,8 @@ make-help-screen
"Help command."
(interactive)
(let ((line-prompt
- (substitute-command-keys ,help-line)))
+ (substitute-command-keys ,help-line))
+ (substitute-command-keys--in-help 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 9122d96271..d527f48020 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -929,7 +929,8 @@ describe-key
seq (event-start event))))
`(,seq ,brief-desc ,defn ,locus)))
key-list))
- 2)))
+ 2))
+ (substitute-command-keys--in-help t))
(help-setup-xref (list (lambda (key-list buf)
(describe-key key-list
(if (buffer-live-p buf) buf)))
@@ -1072,6 +1073,9 @@ help-link-key-to-documentation
:version "29.1"
:group 'help)
+(defvar substitute-command-keys--in-help nil
+ "Internal variable used by `substitute-command-keys'.")
+
(defun substitute-command-keys (string)
"Substitute key descriptions for command names in STRING.
Each substring of the form \\\\=[COMMAND] is replaced by either a
@@ -1181,6 +1185,7 @@ substitute-command-keys
(delete-char (- end-point (point)))
(let ((key (help--key-description-fontified key)))
(insert (if (and help-link-key-to-documentation
+ substitute-command-keys--in-help
(functionp fun))
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
--
2.33.0
^ permalink raw reply related [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 13:34 ` Lars Ingebrigtsen
@ 2021-11-26 0:38 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-26 12:36 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-26 0:38 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
> The nice thing about it being a comment is that you can still say `M-x
> eval-buffer' without it getting in the way.
The `report-emacs-bug' message is displayed with a display property.
The actual text in the buffer is empty.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-25 22:45 ` Gregory Heytings
@ 2021-11-26 6:26 ` Eli Zaretskii
2021-11-26 9:24 ` Robert Pluim
2021-11-27 16:06 ` Gregory Heytings
0 siblings, 2 replies; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-26 6:26 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, larsi, 52053
> Date: Thu, 25 Nov 2021 22:45:02 +0000
> From: Gregory Heytings <gregory@heytings.org>
> cc: luangruo@yahoo.com, larsi@gnus.org, 52053@debbugs.gnu.org
>
> Updated patch attached.
Thanks. This approach is fine by me, but the variable you introduced
should not be internal, and it probably should be called out in NEWS
(in the Lisp section), because I believe the intent was to allow other
callers to use it, even though currently we have only one such caller.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 6:26 ` Eli Zaretskii
@ 2021-11-26 9:24 ` Robert Pluim
2021-11-26 11:13 ` Eli Zaretskii
2021-11-27 16:06 ` Gregory Heytings
1 sibling, 1 reply; 37+ messages in thread
From: Robert Pluim @ 2021-11-26 9:24 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, Gregory Heytings, 52053, larsi
>>>>> On Fri, 26 Nov 2021 08:26:54 +0200, Eli Zaretskii <eliz@gnu.org> said:
>> Date: Thu, 25 Nov 2021 22:45:02 +0000
>> From: Gregory Heytings <gregory@heytings.org>
>> cc: luangruo@yahoo.com, larsi@gnus.org, 52053@debbugs.gnu.org
>>
>> Updated patch attached.
Eli> Thanks. This approach is fine by me, but the variable you introduced
Eli> should not be internal, and it probably should be called out in NEWS
Eli> (in the Lisp section), because I believe the intent was to allow other
Eli> callers to use it, even though currently we have only one such caller.
So a variable that code can set to say 'use this other variable'?
Again, why not just bind `help-link-key-to-documentation' directly?
Robert
--
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 9:24 ` Robert Pluim
@ 2021-11-26 11:13 ` Eli Zaretskii
2021-11-26 11:17 ` Robert Pluim
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-26 11:13 UTC (permalink / raw)
To: Robert Pluim; +Cc: luangruo, gregory, 52053, larsi
> From: Robert Pluim <rpluim@gmail.com>
> Cc: Gregory Heytings <gregory@heytings.org>, luangruo@yahoo.com,
> larsi@gnus.org, 52053@debbugs.gnu.org
> Date: Fri, 26 Nov 2021 10:24:22 +0100
>
> Eli> Thanks. This approach is fine by me, but the variable you introduced
> Eli> should not be internal, and it probably should be called out in NEWS
> Eli> (in the Lisp section), because I believe the intent was to allow other
> Eli> callers to use it, even though currently we have only one such caller.
>
> So a variable that code can set to say 'use this other variable'?
Maybe I'm missing something, but where did you see that this new
variable is used to set help-link-key-to-documentation?
> Again, why not just bind `help-link-key-to-documentation' directly?
Presumably, because help-link-key-to-documentation is a user option,
and an option which is specific to Help commands?
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 11:13 ` Eli Zaretskii
@ 2021-11-26 11:17 ` Robert Pluim
0 siblings, 0 replies; 37+ messages in thread
From: Robert Pluim @ 2021-11-26 11:17 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, gregory, 52053, larsi
>>>>> On Fri, 26 Nov 2021 13:13:28 +0200, Eli Zaretskii <eliz@gnu.org> said:
>> From: Robert Pluim <rpluim@gmail.com>
>> Cc: Gregory Heytings <gregory@heytings.org>, luangruo@yahoo.com,
>> larsi@gnus.org, 52053@debbugs.gnu.org
>> Date: Fri, 26 Nov 2021 10:24:22 +0100
>>
Eli> Thanks. This approach is fine by me, but the variable you introduced
Eli> should not be internal, and it probably should be called out in NEWS
Eli> (in the Lisp section), because I believe the intent was to allow other
Eli> callers to use it, even though currently we have only one such caller.
>>
>> So a variable that code can set to say 'use this other variable'?
Eli> Maybe I'm missing something, but where did you see that this new
Eli> variable is used to set help-link-key-to-documentation?
Itʼs checked to see if help-link-key-to-documentation should be used
(not set).
>> Again, why not just bind `help-link-key-to-documentation' directly?
Eli> Presumably, because help-link-key-to-documentation is a user option,
Eli> and an option which is specific to Help commands?
Right. So Help commands should bind it as necessary.
Robert
--
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 0:38 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-11-26 12:36 ` Lars Ingebrigtsen
2021-11-26 12:52 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-26 12:36 UTC (permalink / raw)
To: Po Lu; +Cc: 52053
Po Lu <luangruo@yahoo.com> writes:
> The `report-emacs-bug' message is displayed with a display property.
> The actual text in the buffer is empty.
Yes, and that's really confusing. I wouldn't want to do something that
weird in *scratch*.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 12:36 ` Lars Ingebrigtsen
@ 2021-11-26 12:52 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 37+ messages in thread
From: Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-11-26 12:52 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 52053
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Yes, and that's really confusing. I wouldn't want to do something that
> weird in *scratch*.
Then I think we should not fontify the key binding specially in that
comment.
Thanks.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-26 6:26 ` Eli Zaretskii
2021-11-26 9:24 ` Robert Pluim
@ 2021-11-27 16:06 ` Gregory Heytings
2021-11-27 16:08 ` Gregory Heytings
1 sibling, 1 reply; 37+ messages in thread
From: Gregory Heytings @ 2021-11-27 16:06 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
>> Updated patch attached.
>
> Thanks. This approach is fine by me, but the variable you introduced
> should not be internal, and it probably should be called out in NEWS (in
> the Lisp section), because I believe the intent was to allow other
> callers to use it, even though currently we have only one such caller.
>
Thanks for your feedback. Updated (and much larger) patch attached.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-27 16:06 ` Gregory Heytings
@ 2021-11-27 16:08 ` Gregory Heytings
2021-11-29 13:56 ` Lars Ingebrigtsen
2021-11-29 17:59 ` Stefan Kangas
0 siblings, 2 replies; 37+ messages in thread
From: Gregory Heytings @ 2021-11-27 16:08 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, larsi, 52053
[-- Attachment #1: Type: text/plain, Size: 414 bytes --]
>>> Updated patch attached.
>>
>> Thanks. This approach is fine by me, but the variable you introduced
>> should not be internal, and it probably should be called out in NEWS
>> (in the Lisp section), because I believe the intent was to allow other
>> callers to use it, even though currently we have only one such caller.
>
> Thanks for your feedback. Updated (and much larger) patch attached.
>
Attached.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff; name=Do-not-buttonize-key-bindings-outside-of-Help-buffer.patch, Size: 65752 bytes --]
From 058c265ab48f8788bd5ef901f9b91fe4a30051ef Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Sat, 27 Nov 2021 15:58:46 +0000
Subject: [PATCH] Do not buttonize key bindings outside of *Help* buffers
* 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.
* etc/NEWS: Mention the new variable.
* lisp/help-macro.el (make-help-screen): 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/repeat.el (describe-repeat-maps): 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.
* lisp/international/mule-cmds.el (describe-input-method,
describe-language-environment): Bind the new variable.
* lisp/button.el (button-describe): Bind the new variable.
* lisp/apropos.el (apropos-describe-plist): 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 8b7c2f7850..d9f50e2ead 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -974,6 +974,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.
+
\f
* Changes in Emacs 29.1 on Non-Free Operating Systems
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 00919ed91b..66a594d588 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1322,17 +1322,18 @@ apropos-previous-symbol
(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 e3f91cb4a6..dd5a71d116 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -604,7 +604,8 @@ button-describe
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 17fabe4f63..32698420e1 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -249,7 +249,8 @@ describe-function
;; 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 @@ describe-variable
(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 @@ describe-face
(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 @@ describe-symbol
(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 @@ describe-syntax
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 @@ describe-categories
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 @@ describe-keymap
(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 @@ describe-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 @@ describe-widget
(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 588efee66b..cd1b51e57a 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -93,7 +93,8 @@ make-help-screen
"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 9122d96271..1917ef425d 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -50,6 +50,11 @@ help-window-point-marker
(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 @@ view-lossage
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))))))
\f
;; Key bindings
@@ -579,31 +585,32 @@ describe-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 @@ describe-key
(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 @@ substitute-command-keys
(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 b922f192a9..9f3f2a2084 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1638,30 +1638,31 @@ describe-input-method
(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 @@ describe-language-environment
(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))))))))))
\f
;;; Locales.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 5cc73e4367..efb9296c11 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -299,65 +299,66 @@ list-charset-chars
(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))))))))
\f
;;; CODING-SYSTEM
@@ -406,89 +407,90 @@ print-designation
(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 @@ describe-font
(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 @@ describe-fontset
(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 @@ list-fontsets
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)))))))))
\f
;;;###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 4dcd353e34..79a51d8c9f 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -515,31 +515,32 @@ describe-repeat-maps
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)
--
2.33.0
^ permalink raw reply related [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-27 16:08 ` Gregory Heytings
@ 2021-11-29 13:56 ` Lars Ingebrigtsen
2021-11-29 14:05 ` Eli Zaretskii
2021-11-29 17:59 ` Stefan Kangas
1 sibling, 1 reply; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-29 13:56 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, 52053
Gregory Heytings <gregory@heytings.org> writes:
>> Thanks for your feedback. Updated (and much larger) patch attached.
>>
>
> Attached.
Eli, do you have any further comments, or should this be applied?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-29 13:56 ` Lars Ingebrigtsen
@ 2021-11-29 14:05 ` Eli Zaretskii
2021-11-29 14:13 ` Lars Ingebrigtsen
0 siblings, 1 reply; 37+ messages in thread
From: Eli Zaretskii @ 2021-11-29 14:05 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: luangruo, gregory, 52053
> From: Lars Ingebrigtsen <larsi@gnus.org>
> Cc: Eli Zaretskii <eliz@gnu.org>, luangruo@yahoo.com, 52053@debbugs.gnu.org
> Date: Mon, 29 Nov 2021 14:56:10 +0100
>
> Gregory Heytings <gregory@heytings.org> writes:
>
> >> Thanks for your feedback. Updated (and much larger) patch attached.
> >>
> >
> > Attached.
>
> Eli, do you have any further comments, or should this be applied?
No further comments, thanks.
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-29 14:05 ` Eli Zaretskii
@ 2021-11-29 14:13 ` Lars Ingebrigtsen
0 siblings, 0 replies; 37+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-29 14:13 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: luangruo, gregory, 52053
Eli Zaretskii <eliz@gnu.org> writes:
>> Eli, do you have any further comments, or should this be applied?
>
> No further comments, thanks.
OK; patch pushed to Emacs 29, then.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 37+ messages in thread
* bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer
2021-11-27 16:08 ` Gregory Heytings
2021-11-29 13:56 ` Lars Ingebrigtsen
@ 2021-11-29 17:59 ` Stefan Kangas
1 sibling, 0 replies; 37+ messages in thread
From: Stefan Kangas @ 2021-11-29 17:59 UTC (permalink / raw)
To: Gregory Heytings; +Cc: luangruo, 52053, larsi
[[Sorry for the late comments here.]]
Gregory Heytings <gregory@heytings.org> writes:
> Attached.
The basic idea sounds good to me, but I have some minor questions:
> diff --git a/lisp/apropos.el b/lisp/apropos.el
[snip]
> + (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 ")"))))
I'm fine with this but I ask myself if binding this variable should be
done in a macro (perhaps `with-help-window'?). I'm too under the
weather to look at or think about this properly, so I'll just leave you
with the question.
> +(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.")
Should we document what the practical effect of this is, instead of when
it is t? Perhaps related, is this the best name for this variable?
Finally, does this call for updating the docstring of
`help-link-key-to-documentation'?
^ permalink raw reply [flat|nested] 37+ messages in thread
end of thread, other threads:[~2021-11-29 17:59 UTC | newest]
Thread overview: 37+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
[not found] <87czmr5gr7.fsf.ref@yahoo.com>
2021-11-23 10:05 ` bug#52053: 29.0.50; Nonsensical button "C-x C-f" in scratch buffer Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 6:17 ` Phil Sainty
2021-11-24 7:53 ` Lars Ingebrigtsen
2021-11-24 9:28 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 10:58 ` Lars Ingebrigtsen
2021-11-24 11:15 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 11:27 ` Lars Ingebrigtsen
2021-11-24 11:36 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-24 16:39 ` Lars Ingebrigtsen
2021-11-24 17:05 ` Andreas Schwab
2021-11-25 0:45 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-25 13:34 ` Lars Ingebrigtsen
2021-11-26 0:38 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-26 12:36 ` Lars Ingebrigtsen
2021-11-26 12:52 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-11-25 10:23 ` Gregory Heytings
2021-11-25 10:59 ` Eli Zaretskii
2021-11-25 11:07 ` Gregory Heytings
2021-11-25 11:21 ` Eli Zaretskii
2021-11-25 12:47 ` Robert Pluim
2021-11-25 13:20 ` Eli Zaretskii
2021-11-25 13:36 ` Lars Ingebrigtsen
2021-11-25 13:41 ` Gregory Heytings
2021-11-25 14:16 ` Eli Zaretskii
2021-11-25 14:55 ` Gregory Heytings
2021-11-25 15:15 ` Eli Zaretskii
2021-11-25 22:45 ` Gregory Heytings
2021-11-26 6:26 ` Eli Zaretskii
2021-11-26 9:24 ` Robert Pluim
2021-11-26 11:13 ` Eli Zaretskii
2021-11-26 11:17 ` Robert Pluim
2021-11-27 16:06 ` Gregory Heytings
2021-11-27 16:08 ` Gregory Heytings
2021-11-29 13:56 ` Lars Ingebrigtsen
2021-11-29 14:05 ` Eli Zaretskii
2021-11-29 14:13 ` Lars Ingebrigtsen
2021-11-29 17:59 ` Stefan Kangas
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.