[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk 4beecd8: Merge remote-tracking branch 'origin/master' into
|
From: |
Po Lu |
|
Subject: |
feature/pgtk 4beecd8: Merge remote-tracking branch 'origin/master' into feature/pgtk |
|
Date: |
Tue, 30 Nov 2021 00:57:00 -0500 (EST) |
branch: feature/pgtk
commit 4beecd8e8cadc70b72f77d4ab202734f1d99eeb0
Merge: 72d223a f3bb2b8
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/pgtk
---
doc/emacs/abbrevs.texi | 2 +-
doc/emacs/custom.texi | 5 +-
doc/emacs/msdos-xtra.texi | 2 +-
doc/emacs/programs.texi | 2 +-
doc/lispref/commands.texi | 55 +---
doc/lispref/display.texi | 18 +-
doc/lispref/help.texi | 2 +-
doc/lispref/keymaps.texi | 39 ++-
doc/lispref/loading.texi | 4 +-
doc/lispref/modes.texi | 42 ++-
doc/lispref/text.texi | 8 +-
doc/lispref/variables.texi | 21 +-
doc/misc/modus-themes.org | 68 ++---
etc/NEWS | 14 +
lisp/apropos.el | 23 +-
lisp/button.el | 3 +-
lisp/cus-start.el | 1 +
lisp/doc-view.el | 7 +-
lisp/emacs-lisp/autoload.el | 2 +-
lisp/emacs-lisp/tabulated-list.el | 4 +
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/keymap.el | 11 +-
lisp/ldefs-boot.el | 135 ++++++----
lisp/net/shr.el | 108 +-------
lisp/progmodes/project.el | 38 ++-
lisp/repeat.el | 51 ++--
lisp/textmodes/fill.el | 6 +-
lisp/textmodes/ispell.el | 2 +-
lisp/textmodes/pixel-fill.el | 202 ++++++++++++++
lisp/thingatpt.el | 15 +-
lisp/wid-edit.el | 3 +-
src/nsterm.h | 2 -
src/nsterm.m | 30 ++-
src/xterm.c | 4 +-
test/infra/gitlab-ci.yml | 4 +-
39 files changed, 1190 insertions(+), 980 deletions(-)
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index c83da8a..972416f 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -274,7 +274,7 @@ Edit a list of abbrevs; you can add, alter or remove
definitions.
@example
@var{various other tables@dots{}}
(lisp-mode-abbrev-table)
-"dk" 0 "define-key"
+"ks" 0 "keymap-set"
(global-abbrev-table)
"dfn" 0 "definition"
@end example
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 917f6f4..310a856 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2567,10 +2567,9 @@ Do the same thing for Lisp mode only.
Redefine all keys which now run @code{next-line} in Fundamental mode
so that they run @code{forward-line} instead.
-@findex substitute-key-definition
+@findex keymap-substitute
@example
-(substitute-key-definition 'next-line 'forward-line
- global-map)
+(keymap-substitute global-map 'next-line 'forward-line)
@end example
@item
diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi
index fce6ae4..114700f 100644
--- a/doc/emacs/msdos-xtra.texi
+++ b/doc/emacs/msdos-xtra.texi
@@ -105,7 +105,7 @@ following line into your @file{_emacs} file:
@smallexample
;; @r{Make the @key{ENTER} key from the numeric keypad act as @kbd{C-j}.}
-(define-key function-key-map [kp-enter] [?\C-j])
+(keymap-set function-key-map "<kp-enter>" "C-j")
@end smallexample
@node MS-DOS Mouse
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 0056906..85ed65a 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1827,7 +1827,7 @@ sure the keymap is loaded before we try to change it.
@example
(defun my-bind-clb ()
- (define-key c-mode-base-map "\C-m"
+ (keymap-set c-mode-base-map "RET"
'c-context-line-break))
(add-hook 'c-initialization-hook 'my-bind-clb)
@end example
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 581183a..920d380 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -455,7 +455,7 @@ This kind of input is used by commands such as
@code{describe-key} and
@item K
A key sequence on a form that can be used as input to functions like
-@code{define-key}. This works like @samp{k}, except that it
+@code{keymap-set}. This works like @samp{k}, except that it
suppresses, for the last input event in the key sequence, the
conversions that are normally used (when necessary) to convert an
undefined key into a defined one (@pxref{Key Sequence Input}), so this
@@ -1315,12 +1315,9 @@ actually treated as the meta key, not this.)
It is best to avoid mentioning specific bit numbers in your program.
To test the modifier bits of a character, use the function
@code{event-modifiers} (@pxref{Classifying Events}). When making key
-bindings, you can use the read syntax for characters with modifier bits
-(@samp{\C-}, @samp{\M-}, and so on). For making key bindings with
-@code{define-key}, you can use lists such as @code{(control hyper ?x)} to
-specify the characters (@pxref{Changing Key Bindings}). The function
-@code{event-convert-list} converts such a list into an event type
-(@pxref{Classifying Events}).
+bindings with @code{keymap-set}, you specify these events using
+strings like @samp{C-H-x} instead (for ``control hyper x'')
+(@pxref{Changing Key Bindings}).
@node Function Keys
@subsection Function Keys
@@ -2078,7 +2075,7 @@ example:
(interactive)
(message "Caught signal %S" last-input-event))
-(define-key special-event-map [sigusr1] 'sigusr-handler)
+(keymap-set special-event-map "<sigusr1>" 'sigusr-handler)
@end smallexample
To test the signal handler, you can make Emacs send a signal to itself:
@@ -2284,21 +2281,6 @@ This function returns non-@code{nil} if @var{object} is
a mouse movement
event. @xref{Motion Events}.
@end defun
-@defun event-convert-list list
-This function converts a list of modifier names and a basic event type
-to an event type which specifies all of them. The basic event type
-must be the last element of the list. For example,
-
-@example
-(event-convert-list '(control ?a))
- @result{} 1
-(event-convert-list '(control meta ?a))
- @result{} -134217727
-(event-convert-list '(control super f1))
- @result{} C-s-f1
-@end example
-@end defun
-
@node Accessing Mouse
@subsection Accessing Mouse Events
@cindex mouse events, data in
@@ -2518,25 +2500,14 @@ characters in a string is a complex matter, for reasons
of historical
compatibility, and it is not always possible.
We recommend that new programs avoid dealing with these complexities
-by not storing keyboard events in strings. Here is how to do that:
-
-@itemize @bullet
-@item
-Use vectors instead of strings for key sequences, when you plan to use
-them for anything other than as arguments to @code{lookup-key} and
-@code{define-key}. For example, you can use
-@code{read-key-sequence-vector} instead of @code{read-key-sequence}, and
-@code{this-command-keys-vector} instead of @code{this-command-keys}.
-
-@item
-Use vectors to write key sequence constants containing meta characters,
-even when passing them directly to @code{define-key}.
-
-@item
-When you have to look at the contents of a key sequence that might be a
-string, use @code{listify-key-sequence} (@pxref{Event Input Misc})
-first, to convert it to a list.
-@end itemize
+by not storing keyboard events in strings containing control
+characters or the like, but instead store them in the common Emacs
+format as understood by @code{key-valid-p}.
+
+ If you read a key sequence with @code{read-key-sequence-vector} (or
+@code{read-key-sequence}), or access a key sequence with
+@code{this-command-keys-vector} (or @code{this-command-keys}), you can
+transform this to the recommended format by using @code{key-description}.
The complexities stem from the modifier bits that keyboard input
characters can include. Aside from the Meta modifier, none of these
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 0bdbc06..f37b351 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -7777,16 +7777,14 @@ The string is formatted #RRGGBB (hash followed by six
hex digits)."
(kill-buffer nil))
(setq colorcomp-mode-map
- (let ((m (make-sparse-keymap)))
- (suppress-keymap m)
- (define-key m "i" 'colorcomp-R-less)
- (define-key m "o" 'colorcomp-R-more)
- (define-key m "k" 'colorcomp-G-less)
- (define-key m "l" 'colorcomp-G-more)
- (define-key m "," 'colorcomp-B-less)
- (define-key m "." 'colorcomp-B-more)
- (define-key m " " 'colorcomp-copy-as-kill-and-exit)
- m))
+ (define-keymap :suppress t
+ "i" 'colorcomp-R-less
+ "o" 'colorcomp-R-more
+ "k" 'colorcomp-G-less
+ "l" 'colorcomp-G-more
+ "," 'colorcomp-B-less
+ "." 'colorcomp-B-more
+ "SPC" 'colorcomp-copy-as-kill-and-exit))
@end smallexample
Note that we never modify the data in each node, which is fixed when the
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 1a9eb30..71017a4 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -647,7 +647,7 @@ follows:
@smallexample
@group
-(define-key global-map (string help-char) 'help-command)
+(keymap-set global-map (key-description (string help-char)) 'help-command)
(fset 'help-command help-map)
@end group
@end smallexample
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index d893e22..edf1d6e 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -367,7 +367,7 @@ I.e., something like:
@group
(let ((map (make-sparse-keymap)))
(set-keymap-parent map <theirmap>)
- (define-key map ...)
+ (keymap-set map ...)
...)
@end group
@end example
@@ -420,10 +420,10 @@ The effect is that this keymap inherits all the bindings
of
but can add to them or override them with @var{elements}.
If you change the bindings in @var{parent-keymap} using
-@code{define-key} or other key-binding functions, these changed
+@code{keymap-set} or other key-binding functions, these changed
bindings are visible in the inheriting keymap, unless shadowed by the
bindings made by @var{elements}. The converse is not true: if you use
-@code{define-key} to change bindings in the inheriting keymap, these
+@code{keymap-set} to change bindings in the inheriting keymap, these
changes are recorded in @var{elements}, but have no effect on
@var{parent-keymap}.
@@ -797,7 +797,7 @@ out with.
This function returns the current global keymap. This is the same as
the value of @code{global-map} unless you change one or the other.
The return value is a reference, not a copy; if you use
-@code{define-key} or other functions on it you will alter global
+@code{keymap-set} or other functions on it you will alter global
bindings.
@example
@@ -833,7 +833,7 @@ keymap.
@end defun
@code{current-local-map} returns a reference to the local keymap, not
-a copy of it; if you use @code{define-key} or other functions on it
+a copy of it; if you use @code{keymap-set} or other functions on it
you will alter local bindings.
@defun current-minor-mode-maps
@@ -1297,7 +1297,7 @@ This function sets the binding for @var{key} in
@var{keymap}. (If
in another keymap reached from @var{keymap}.) The argument
@var{binding} can be any Lisp object, but only certain types are
meaningful. (For a list of meaningful types, see @ref{Key Lookup}.)
-The value returned by @code{define-key} is @var{binding}.
+The value returned by @code{keymap-set} is @var{binding}.
If @var{key} is @kbd{<t>}, this sets the default binding in
@var{keymap}. When an event has no binding of its own, the Emacs
@@ -1726,6 +1726,21 @@ The argument @var{accept-defaults} controls checking for
default bindings,
as in @code{lookup-key} (above).
@end defun
+@defun event-convert-list list
+This function converts a list of modifier names and a basic event type
+to an event type which specifies all of them. The basic event type
+must be the last element of the list. For example,
+
+@example
+(event-convert-list '(control ?a))
+ @result{} 1
+(event-convert-list '(control meta ?a))
+ @result{} -134217727
+(event-convert-list '(control super f1))
+ @result{} C-s-f1
+@end example
+@end defun
+
@node Remapping Commands
@section Remapping Commands
@cindex remapping commands
@@ -1744,7 +1759,7 @@ definition for a key binding).
the following remapping:
@smallexample
-(define-key my-mode-map [remap kill-line] 'my-kill-line)
+(keymap-set my-mode-map "<remap> <kill-line>" 'my-kill-line)
@end smallexample
@noindent
@@ -1759,8 +1774,8 @@ In addition, remapping only works through a single level;
in the
following example,
@smallexample
-(define-key my-mode-map [remap kill-line] 'my-kill-line)
-(define-key my-mode-map [remap my-kill-line] 'my-other-kill-line)
+(keymap-set my-mode-map "<remap> <kill-line>" 'my-kill-line)
+(keymap-set my-mode-map "<remap> <my-kill-line>" 'my-other-kill-line)
@end smallexample
@noindent
@@ -1772,7 +1787,7 @@ remapped to @code{my-kill-line}; if an ordinary binding
specifies
To undo the remapping of a command, remap it to @code{nil}; e.g.,
@smallexample
-(define-key my-mode-map [remap kill-line] nil)
+(keymap-set my-mode-map "<remap> <kill-line>" nil)
@end smallexample
@defun command-remapping command &optional position keymaps
@@ -1904,7 +1919,7 @@ to turn the character that follows into a Hyper character:
symbol
(cons symbol (cdr e)))))
-(define-key local-function-key-map "\C-ch" 'hyperify)
+(keymap-set local-function-key-map "C-c h" 'hyperify)
@end group
@end example
@@ -1934,7 +1949,7 @@ problematic suffixes/prefixes are @kbd{@key{ESC}},
@kbd{M-O} (which is really
@section Commands for Binding Keys
This section describes some convenient interactive interfaces for
-changing key bindings. They work by calling @code{define-key}.
+changing key bindings. They work by calling @code{keymap-set}.
People often use @code{keymap-global-set} in their init files
(@pxref{Init File}) for simple customization. For example,
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 4d683da..ee11944 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -552,7 +552,7 @@ An autoloaded keymap loads automatically during key lookup
when a prefix
key's binding is the symbol @var{function}. Autoloading does not occur
for other kinds of access to the keymap. In particular, it does not
happen when a Lisp program gets the keymap from the value of a variable
-and calls @code{define-key}; not even if the variable name is the same
+and calls @code{keymap-set}; not even if the variable name is the same
symbol @var{function}.
@cindex function cell in autoload
@@ -1156,7 +1156,7 @@ You don't need to give a directory or extension in the
file name
@var{library}. Normally, you just give a bare file name, like this:
@example
-(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval))
+(with-eval-after-load "js" (keymap-set js-mode-map "C-c C-c" 'js-eval))
@end example
To restrict which files can trigger the evaluation, include a
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index bc5c08c..69c022e 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -916,10 +916,8 @@ which in turn may have been changed in a mode hook.
Here is a hypothetical example:
@example
-(defvar hypertext-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [down-mouse-3] 'do-hyper-link)
- map))
+(defvar-keymap hypertext-mode-map
+ "<down-mouse-3>" #'do-hyper-link)
(define-derived-mode hypertext-mode
text-mode "Hypertext"
@@ -1344,11 +1342,9 @@ the conventions listed above:
;; @r{Create the keymap for this mode.}
@group
-(defvar text-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\e\t" 'ispell-complete-word)
- @dots{}
- map)
+(defvar-keymap text-mode-map
+ "C-M-i" #'ispell-complete-word
+ @dots{})
"Keymap for `text-mode'.
Many other modes, such as `mail-mode', `outline-mode' and
`indented-text-mode', inherit all the commands defined in this map.")
@@ -1421,13 +1417,11 @@ common. The following code sets up the common commands:
@smallexample
@group
-(defvar lisp-mode-shared-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map prog-mode-map)
- (define-key map "\e\C-q" 'indent-sexp)
- (define-key map "\177" 'backward-delete-char-untabify)
- map)
- "Keymap for commands shared by all sorts of Lisp modes.")
+(defvar-keymap lisp-mode-shared-map
+ :parent prog-mode-map
+ :doc "Keymap for commands shared by all sorts of Lisp modes."
+ "C-M-q" #'indent-sexp
+ "DEL" #'backward-delete-char-untabify)
@end group
@end smallexample
@@ -1436,16 +1430,12 @@ And here is the code to set up the keymap for Lisp mode:
@smallexample
@group
-(defvar lisp-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Lisp")))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\C-x" 'lisp-eval-defun)
- (define-key map "\C-c\C-z" 'run-lisp)
- @dots{}
- map)
- "Keymap for ordinary Lisp mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
+(defvar-keymap lisp-mode-map
+ :doc "Keymap for ordinary Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map."
+ :parent lisp-mode-shared-map
+ "C-M-x" #'lisp-eval-defun
+ "C-c C-z" #'run-lisp)
@end group
@end smallexample
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 863b318..25579e7 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4195,7 +4195,7 @@ position. The action code is always @code{t}.
For example, here is how Info mode handles @key{mouse-1}:
@smallexample
-(define-key Info-mode-map [follow-link] 'mouse-face)
+(keymap-set Info-mode-map "<follow-link>" 'mouse-face)
@end smallexample
@item a function
@@ -4208,9 +4208,9 @@ For example, here is how pcvs enables @kbd{mouse-1} to
follow links on
file names only:
@smallexample
-(define-key map [follow-link]
- (lambda (pos)
- (eq (get-char-property pos 'face) 'cvs-filename-face)))
+(keymap-set map "<follow-link>"
+ (lambda (pos)
+ (eq (get-char-property pos 'face) 'cvs-filename-face)))
@end smallexample
@item anything else
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 1ae0e5e..abef0b3 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -686,7 +686,7 @@ entire computation of the value into the @code{defvar},
like this:
@example
(defvar my-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-a" 'my-command)
+ (keymap-set map "C-c C-a" 'my-command)
@dots{}
map)
@var{docstring})
@@ -702,25 +702,6 @@ important if the user has run hooks to alter part of the
contents
(such as, to rebind keys). Third, evaluating the @code{defvar} form
with @kbd{C-M-x} will reinitialize the map completely.
- Putting so much code in the @code{defvar} form has one disadvantage:
-it puts the documentation string far away from the line which names the
-variable. Here's a safe way to avoid that:
-
-@example
-(defvar my-mode-map nil
- @var{docstring})
-(unless my-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-a" 'my-command)
- @dots{}
- (setq my-mode-map map)))
-@end example
-
-@noindent
-This has all the same advantages as putting the initialization inside
-the @code{defvar}, except that you must type @kbd{C-M-x} twice, once on
-each form, if you do want to reinitialize the variable.
-
@node Accessing Variables
@section Accessing Variable Values
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index f3c2e37..f67a179 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -279,9 +279,9 @@ With those granted, bear in mind a couple of technical
points on
2. The functions will run the ~modus-themes-after-load-theme-hook~ as
their final step. This can be employed for bespoke configurations
- ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization
(do-it-yourself)]]). Experienced users may not
- wish to rely on such a hook and the functions that run it: they may
- prefer a custom solution ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A
theme-agnostic hook for theme loading]]).
+ ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
Experienced users may not wish to rely
+ on such a hook and the functions that run it: they may prefer a
+ custom solution ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A
theme-agnostic hook for theme loading]]).
** Sample configuration with and without use-package
:properties:
@@ -515,7 +515,7 @@ Enable this behaviour by setting this variable to ~nil~.
Regardless of this option, the active theme must be reloaded for changes
to user options to take effect
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]).
-** Option for color-coding success state (deuteranopia)
+** Option for color-coding success state
:properties:
:alt_title: Success' color-code
:description: Toggle blue color for success or done states
@@ -1151,7 +1151,7 @@ To disable fringe indicators for Flymake or Flycheck,
refer to variables
~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~,
respectively.
-** Option for line highlighting (hl-line-mode)
+** Option for line highlighting
:properties:
:alt_title: Line highlighting
:description: Choose style of current line (hl-line-mode)
@@ -1205,7 +1205,7 @@ with underlines.
This style affects several packages that enable ~hl-line-mode~, such as
=elfeed=, =notmuch=, and =mu4e=.
-** Option for line numbers (display-line-numbers-mode)
+** Option for line numbers
:properties:
:alt_title: Line numbers
:description: Toggle subtle style for line numbers
@@ -1260,7 +1260,7 @@ combined with a subtle background.
With a non-nil value (~t~), these constructs will use a more prominent
background and foreground color combination instead.
-** Option for parenthesis matching (show-paren-mode)
+** Option for parenthesis matching
:properties:
:alt_title: Matching parentheses
:description: Choose between various styles for matching delimiters/parentheses
@@ -1913,7 +1913,7 @@ With a non-nil value (~t~) apply a proportionately spaced
typeface, else
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
-* Advanced customization (do-it-yourself)
+* Advanced customization
:properties:
:custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb
:end:
@@ -1928,7 +1928,7 @@ their own local tweaks and who are willing to deal with
any possible
incompatibilities between versioned releases of the themes. As such,
they are labelled as "do-it-yourself" or "DIY".
-** Per-theme customization settings (DIY)
+** Per-theme customization settings
:properties:
:custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193
:end:
@@ -1963,7 +1963,7 @@ equivalent the themes provide.
For a more elaborate design, it is better to inspect the source code of
~modus-themes-toggle~ and relevant functions.
-** Case-by-case face specs using the themes' palette (DIY)
+** Case-by-case face specs using the themes' palette
:properties:
:custom_id: h:1487c631-f4fe-490d-8d58-d72ffa3bd474
:end:
@@ -2067,7 +2067,7 @@ Take the previous example with the ~cursor~ face:
(set-face-attribute 'cursor nil :background (modus-themes-color-alts 'blue
'red))
#+end_src
-** Face specs at scale using the themes' palette (DIY)
+** Face specs at scale using the themes' palette
:properties:
:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
:end:
@@ -2182,7 +2182,7 @@ the previous section. Adapt the above example like this:
...))
#+end_src
-** Remap face with local value (DIY)
+** Remap face with local value
:properties:
:custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f
:end:
@@ -2244,7 +2244,7 @@ Perhaps you may wish to generalise those findings in to a
set of
functions that also accept an arbitrary face. We shall leave the
experimentation up to you.
-** Cycle through arbitrary colors (DIY)
+** Cycle through arbitrary colors
:properties:
:custom_id: h:77dc4a30-b96a-4849-85a8-fee3c2995305
:end:
@@ -2408,7 +2408,7 @@ Must become this:
...)
#+end_src
-** Override colors (DIY)
+** Override colors
:properties:
:custom_id: h:307d95dd-8dbd-4ece-a543-10ae86f155a6
:end:
@@ -2524,7 +2524,7 @@ that we provide:
[[#h:02e25930-e71a-493d-828a-8907fc80f874][test color combinati
ratio between two color values, so it can help in overriding the palette
(or a subset thereof) without making the end result inaccessible.
-** Override color saturation (DIY)
+** Override color saturation
:properties:
:custom_id: h:4589acdc-2505-41fc-9f5e-699cfc45ab00
:end:
@@ -2644,7 +2644,7 @@ inspiration from the ~modus-themes-toggle~ we already
provide:
('modus-vivendi (modus-themes-load-vivendi))))
#+end_src
-** Font configurations for Org and others (DIY)
+** Font configurations for Org and others
:properties:
:custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929
:end:
@@ -2708,9 +2708,9 @@ scale gracefully when using something like the
~text-scale-adjust~ command
which only operates on the base font size (i.e. the ~default~ face's
absolute height).
-[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts (SHR
fonts)]].
+[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts]].
-** Configure bold and italic faces (DIY)
+** Configure bold and italic faces
:properties:
:custom_id: h:2793a224-2109-4f61-a106-721c57c01375
:end:
@@ -2805,7 +2805,7 @@ of the themes, which can make it easier to redefine faces
in bulk).
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the
themes' palette]].
-** Custom Org user faces (DIY)
+** Custom Org user faces
:properties:
:custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad
:end:
@@ -2893,7 +2893,7 @@ it if you plan to control face attributes.
[[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]].
-** Update Org block delimiter fontification (DIY)
+** Update Org block delimiter fontification
:properties:
:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
:end:
@@ -2935,7 +2935,7 @@ Run this function at the post theme load phase, such as
with the
(font-lock-flush)))
#+end_src
-** Measure color contrast (DIY)
+** Measure color contrast
:properties:
:custom_id: h:02e25930-e71a-493d-828a-8907fc80f874
:end:
@@ -3008,7 +3008,7 @@ minutia and relevant commentary.
Such knowledge may prove valuable while attempting to override some of
the themes' colors: [[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override
colors]].
-** Load theme depending on time of day (DIY)
+** Load theme depending on time of day
:properties:
:custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26
:end:
@@ -3035,7 +3035,7 @@ package:
(circadian-setup))
#+end_src
-** Backdrop for pdf-tools (DIY)
+** Backdrop for pdf-tools
:properties:
:custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd
:end:
@@ -3097,7 +3097,7 @@ With those in place, PDFs have a distinct backdrop for
their page, while
they automatically switch to their dark mode when ~modus-themes-toggle~ is
called from inside a buffer whose major-mode is ~pdf-view-mode~.
-** Decrease mode line height (DIY)
+** Decrease mode line height
:properties:
:custom_id: h:03be4438-dae1-4961-9596-60a307c070b5
:end:
@@ -3192,7 +3192,7 @@ to be specified as well:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
-** A theme-agnostic hook for theme loading (DIY)
+** A theme-agnostic hook for theme loading
:properties:
:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
:end:
@@ -3806,7 +3806,7 @@ of the techniques that are discussed at length in the
various
"Do-It-Yourself" (DIY) sections, which provide insight into the more
advanced customization options of the themes.
-[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization
(do-it-yourself)]].
+[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]].
In the following example, we are assuming that the user wants to (i)
re-use color variables provided by the themes, (ii) be able to retain
@@ -4072,12 +4072,12 @@ examples with the 4, 8, 16 colors):
:custom_id: h:4da1d515-3e05-47ef-9e45-8251fc7e986a
:end:
-The ~god-mode~ library does not provide faces that could be configured by
-the Modus themes. Users who would like to get some visual feedback on
-the status of {{{kbd(M-x god-mode)}}} are instead encouraged by upstream to
-set up their own configurations, such as by changing the ~mode-line~ face
-([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization
(do-it-yourself)]]). This is an adaptation of the
-approach followed in the upstream README:
+The ~god-mode~ library does not provide faces that could be configured
+by the Modus themes. Users who would like to get some visual feedback
+on the status of {{{kbd(M-x god-mode)}}} are instead encouraged by upstream
+to set up their own configurations, such as by changing the ~mode-line~
+face ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
This is an adaptation of the approach
+followed in the upstream README:
#+begin_src emacs-lisp
(defun my-god-mode-update-mode-line ()
@@ -4171,7 +4171,7 @@ specifications the webpage provides.
Consult {{{kbd(C-h v shr-use-colors)}}}.
-** Note on EWW and Elfeed fonts (SHR fonts)
+** Note on EWW and Elfeed fonts
:properties:
:custom_id: h:e6c5451f-6763-4be7-8fdb-b4706a422a4c
:end:
@@ -4285,7 +4285,7 @@ you've customized any faces.
"-draw" "text %X,%Y '%c'"))))
#+end_src
-* Frequently Asked Questions (FAQ)
+* Frequently Asked Questions
:properties:
:custom_id: h:b3384767-30d3-4484-ba7f-081729f03a47
:end:
diff --git a/etc/NEWS b/etc/NEWS
index 87a7a43..1ca5c86 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -295,6 +295,13 @@ received.
* Changes in Specialized Modes and Packages in Emacs 29.1
+** pixel-fill
+
+*** This is a new package that deals with filling variable-pitch text.
+
+*** New function 'pixel-fill-region'.
+This fills the region to be no wider than a specified pixel width.
+
** Info
---
@@ -427,6 +434,10 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}'
faces.
*** 'project-find-file' and 'project-or-external-find-file' now accept
a prefix argument which is interpreted to mean "include all files".
+*** 'project-kill-buffers' can display the list of buffers to kill.
+Customize the user option 'project-kill-buffers-display-buffer-list'
+to enable the display of the buffer list.
+
+++
*** New command 'xref-go-forward'.
It is bound to 'C-M-,' and jumps to the location where 'xref-go-back'
@@ -992,6 +1003,9 @@ that should be displayed, and the xwidget that asked to
display it.
This function is used to control where and if an xwidget stores
cookies set by web pages on disk.
+** New variable 'help-buffer-under-preparation'.
+This variable is bound to t during the preparation of a *Help* buffer.
+
* Changes in Emacs 29.1 on Non-Free Operating Systems
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 00919ed..66a594d 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1322,17 +1322,18 @@ as a heading."
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
- (help-setup-xref (list 'apropos-describe-plist symbol)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (set-buffer standard-output)
- (princ "Symbol ")
- (prin1 symbol)
- (princ (substitute-command-keys "'s plist is\n ("))
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face 'apropos-symbol)
- (insert (apropos-format-plist symbol "\n "))
- (princ ")")))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list 'apropos-describe-plist symbol)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (set-buffer standard-output)
+ (princ "Symbol ")
+ (prin1 symbol)
+ (princ (substitute-command-keys "'s plist is\n ("))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
+ (insert (apropos-format-plist symbol "\n "))
+ (princ ")"))))
(provide 'apropos)
diff --git a/lisp/button.el b/lisp/button.el
index e3f91cb..dd5a71d 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -604,7 +604,8 @@ When called from Lisp, pass BUTTON-OR-POS as the button to
describe, or a
buffer position where a button is present. If BUTTON-OR-POS is nil, the
button at point is the button to describe."
(interactive "d")
- (let* ((button (cond ((integer-or-marker-p button-or-pos)
+ (let* ((help-buffer-under-preparation t)
+ (button (cond ((integer-or-marker-p button-or-pos)
(button-at button-or-pos))
((null button-or-pos) (button-at (point)))
((overlayp button-or-pos) button-or-pos)))
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 33b861b..53cad99 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -572,6 +572,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(ns-use-native-fullscreen ns boolean "24.4")
(ns-use-fullscreen-animation ns boolean "25.1")
(ns-use-srgb-colorspace ns boolean "24.4")
+ (ns-scroll-event-delta-factor ns float "29.1")
;; process.c
(delete-exited-processes processes-basics boolean)
;; syntax.c
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 7e113e4..11559bf 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -811,9 +811,10 @@ OpenDocument format)."
(and doc-view-dvipdfm-program
(executable-find doc-view-dvipdfm-program)))))
((memq type '(postscript ps eps pdf))
- ;; FIXME: allow mupdf here
- (and doc-view-ghostscript-program
- (executable-find doc-view-ghostscript-program)))
+ (or (and doc-view-ghostscript-program
+ (executable-find doc-view-ghostscript-program))
+ (and doc-view-pdfdraw-program
+ (executable-find doc-view-pdfdraw-program))))
((eq type 'odf)
(and doc-view-odf->pdf-converter-program
(executable-find doc-view-odf->pdf-converter-program)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 148fb70..23fb400 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -393,7 +393,7 @@ FILE's name."
(concat ";;; " basename
" --- automatically extracted " (or type "autoloads")
" -*- lexical-binding: t -*-\n"
- (when (equal basename "loaddefs.el")
+ (when (string-match "/lisp/loaddefs\\.el\\'" file)
";; This file will be copied to ldefs-boot.el and checked in
periodically.\n")
";;\n"
";;; Code:\n\n"
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index 8f6c655..075fe83 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -684,6 +684,10 @@ With a numeric prefix argument N, sort the Nth column.
If the numeric prefix is -1, restore order the list was
originally displayed in."
(interactive "P")
+ (when (and n
+ (or (>= n (length tabulated-list-format))
+ (< n -1)))
+ (user-error "Invalid column number"))
(if (equal n -1)
;; Restore original order.
(progn
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 17fabe4..3269842 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -249,7 +249,8 @@ handling of autoloaded functions."
;; calling that.
(let ((describe-function-orig-buffer
(or describe-function-orig-buffer
- (current-buffer))))
+ (current-buffer)))
+ (help-buffer-under-preparation t))
(help-setup-xref
(list (lambda (function buffer)
@@ -1078,7 +1079,8 @@ it is displayed along with the global value."
(if (symbolp v) (symbol-name v))))
(list (if (equal val "")
v (intern val)))))
- (let (file-name)
+ (let (file-name
+ (help-buffer-under-preparation t))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(unless (frame-live-p frame) (setq frame (selected-frame)))
(if (not (symbolp variable))
@@ -1461,77 +1463,78 @@ If FRAME is omitted or nil, use the selected frame."
(interactive (list (read-face-name "Describe face"
(or (face-at-point t) 'default)
t)))
- (help-setup-xref (list #'describe-face face)
- (called-interactively-p 'interactive))
- (unless face
- (setq face 'default))
- (if (not (listp face))
- (setq face (list face)))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (dolist (f face (buffer-string))
- (if (stringp f) (setq f (intern f)))
- ;; We may get called for anonymous faces (i.e., faces
- ;; expressed using prop-value plists). Those can't be
- ;; usefully customized, so ignore them.
- (when (symbolp f)
- (insert "Face: " (symbol-name f))
- (if (not (facep f))
- (insert " undefined face.\n")
- (let ((customize-label "customize this face")
- file-name)
- (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
- (princ (concat " (" customize-label ")\n"))
- ;; FIXME not sure how much of this belongs here, and
- ;; how much in `face-documentation'. The latter is
- ;; not used much, but needs to return nil for
- ;; undocumented faces.
- (let ((alias (get f 'face-alias))
- (face f)
- obsolete)
- (when alias
- (setq face alias)
- (insert
- (format-message
- "\n %s is an alias for the face `%s'.\n%s"
- f alias
- (if (setq obsolete (get f 'obsolete-face))
- (format-message
- " This face is obsolete%s; use `%s' instead.\n"
- (if (stringp obsolete)
- (format " since %s" obsolete)
- "")
- alias)
- ""))))
- (insert "\nDocumentation:\n"
- (substitute-command-keys
- (or (face-documentation face)
- "Not documented as a face."))
- "\n\n"))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-face f)))
- (setq file-name (find-lisp-object-file-name f 'defface))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol f))
- (setq help-mode--current-data (list :symbol f
- :file file-name))
- (princ (substitute-command-keys "Defined in `"))
- (princ (help-fns-short-filename file-name))
- (princ (substitute-command-keys "'"))
- ;; Make a hyperlink to the library.
- (save-excursion
- (re-search-backward
- (substitute-command-keys "`\\([^`']+\\)'") nil t)
- (help-xref-button 1 'help-face-def f file-name))
- (princ ".")
- (terpri)
- (terpri))))
- (terpri)
- (help-fns--run-describe-functions
- help-fns-describe-face-functions f frame))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-face face)
+ (called-interactively-p 'interactive))
+ (unless face
+ (setq face 'default))
+ (if (not (listp face))
+ (setq face (list face)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (dolist (f face (buffer-string))
+ (if (stringp f) (setq f (intern f)))
+ ;; We may get called for anonymous faces (i.e., faces
+ ;; expressed using prop-value plists). Those can't be
+ ;; usefully customized, so ignore them.
+ (when (symbolp f)
+ (insert "Face: " (symbol-name f))
+ (if (not (facep f))
+ (insert " undefined face.\n")
+ (let ((customize-label "customize this face")
+ file-name)
+ (insert (concat " (" (propertize "sample" 'font-lock-face f)
")"))
+ (princ (concat " (" customize-label ")\n"))
+ ;; FIXME not sure how much of this belongs here, and
+ ;; how much in `face-documentation'. The latter is
+ ;; not used much, but needs to return nil for
+ ;; undocumented faces.
+ (let ((alias (get f 'face-alias))
+ (face f)
+ obsolete)
+ (when alias
+ (setq face alias)
+ (insert
+ (format-message
+ "\n %s is an alias for the face `%s'.\n%s"
+ f alias
+ (if (setq obsolete (get f 'obsolete-face))
+ (format-message
+ " This face is obsolete%s; use `%s' instead.\n"
+ (if (stringp obsolete)
+ (format " since %s" obsolete)
+ "")
+ alias)
+ ""))))
+ (insert "\nDocumentation:\n"
+ (substitute-command-keys
+ (or (face-documentation face)
+ "Not documented as a face."))
+ "\n\n"))
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward
+ (concat "\\(" customize-label "\\)") nil t)
+ (help-xref-button 1 'help-customize-face f)))
+ (setq file-name (find-lisp-object-file-name f 'defface))
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol f))
+ (setq help-mode--current-data (list :symbol f
+ :file file-name))
+ (princ (substitute-command-keys "Defined in `"))
+ (princ (help-fns-short-filename file-name))
+ (princ (substitute-command-keys "'"))
+ ;; Make a hyperlink to the library.
+ (save-excursion
+ (re-search-backward
+ (substitute-command-keys "`\\([^`']+\\)'") nil t)
+ (help-xref-button 1 'help-face-def f file-name))
+ (princ ".")
+ (terpri)
+ (terpri))))
+ (terpri)
+ (help-fns--run-describe-functions
+ help-fns-describe-face-functions f frame)))))))
(add-hook 'help-fns-describe-face-functions
#'help-fns--face-custom-version-info)
@@ -1602,43 +1605,44 @@ current buffer and the selected frame, respectively."
(if found (symbol-name v-or-f)))))
(list (if (equal val "")
(or v-or-f "") (intern val)))))
- (if (not (symbolp symbol))
- (user-error "You didn't specify a function or variable"))
- (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
- (unless (frame-live-p frame) (setq frame (selected-frame)))
- (with-current-buffer (help-buffer)
- ;; Push the previous item on the stack before clobbering the output buffer.
- (help-setup-xref nil nil)
- (let* ((docs
- (nreverse
- (delq nil
- (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
- (when (funcall testfn symbol)
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (cons name
- (funcall descfn symbol buffer frame))))
- describe-symbol-backends))))
- (single (null (cdr docs))))
- (while (cdr docs)
- (goto-char (point-min))
- (let ((inhibit-read-only t)
- (name (caar docs)) ;Name of doc currently at BOB.
- (doc (cdr (cadr docs)))) ;Doc to add at BOB.
- (when doc
- (insert doc)
- (delete-region (point)
- (progn (skip-chars-backward " \t\n") (point)))
- (insert "\n\n" (make-separator-line) "\n")
- (when name
- (insert (symbol-name symbol)
- " is also a " name "." "\n\n"))))
- (setq docs (cdr docs)))
- (unless single
- ;; Don't record the `describe-variable' item in the stack.
- (setq help-xref-stack-item nil)
- (help-setup-xref (list #'describe-symbol symbol) nil))
- (goto-char (point-min)))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (symbolp symbol))
+ (user-error "You didn't specify a function or variable"))
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+ (with-current-buffer (help-buffer)
+ ;; Push the previous item on the stack before clobbering the output
buffer.
+ (help-setup-xref nil nil)
+ (let* ((docs
+ (nreverse
+ (delq nil
+ (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
+ (when (funcall testfn symbol)
+ ;; Don't record the current entry in the
stack.
+ (setq help-xref-stack-item nil)
+ (cons name
+ (funcall descfn symbol buffer frame))))
+ describe-symbol-backends))))
+ (single (null (cdr docs))))
+ (while (cdr docs)
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (name (caar docs)) ;Name of doc currently at BOB.
+ (doc (cdr (cadr docs)))) ;Doc to add at BOB.
+ (when doc
+ (insert doc)
+ (delete-region (point)
+ (progn (skip-chars-backward " \t\n") (point)))
+ (insert "\n\n" (make-separator-line) "\n")
+ (when name
+ (insert (symbol-name symbol)
+ " is also a " name "." "\n\n"))))
+ (setq docs (cdr docs)))
+ (unless single
+ ;; Don't record the `describe-variable' item in the stack.
+ (setq help-xref-stack-item nil)
+ (help-setup-xref (list #'describe-symbol symbol) nil))
+ (goto-char (point-min))))))
;;;###autoload
(defun describe-syntax (&optional buffer)
@@ -1647,15 +1651,16 @@ The descriptions are inserted in a help buffer, which
is then displayed.
BUFFER defaults to the current buffer."
(interactive)
(setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-syntax buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (let ((table (with-current-buffer buffer (syntax-table))))
- (with-current-buffer standard-output
- (describe-vector table 'internal-describe-syntax-value)
- (while (setq table (char-table-parent table))
- (insert "\nThe parent syntax table is:")
- (describe-vector table 'internal-describe-syntax-value))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-syntax buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (let ((table (with-current-buffer buffer (syntax-table))))
+ (with-current-buffer standard-output
+ (describe-vector table 'internal-describe-syntax-value)
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent syntax table is:")
+ (describe-vector table 'internal-describe-syntax-value)))))))
(defun help-describe-category-set (value)
(insert (cond
@@ -1672,59 +1677,60 @@ The descriptions are inserted in a buffer, which is
then displayed.
If BUFFER is non-nil, then describe BUFFER's category table instead.
BUFFER should be a buffer or a buffer name."
(interactive)
- (setq buffer (or buffer (current-buffer)))
- (help-setup-xref (list #'describe-categories buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (let* ((table (with-current-buffer buffer (category-table)))
- (docs (char-table-extra-slot table 0)))
- (if (or (not (vectorp docs)) (/= (length docs) 95))
- (error "Invalid first extra slot in this category table\n"))
- (with-current-buffer standard-output
- (setq-default help-button-cache (make-marker))
- (insert "Legend of category mnemonics ")
- (insert-button "(longer descriptions at the bottom)"
- 'action help-button-cache
- 'follow-link t
- 'help-echo "mouse-2, RET: show full legend")
- (insert "\n")
- (let ((pos (point)) (items 0) lines n)
- (dotimes (i 95)
- (if (aref docs i) (setq items (1+ items))))
- (setq lines (1+ (/ (1- items) 4)))
- (setq n 0)
+ (let ((help-buffer-under-preparation t))
+ (setq buffer (or buffer (current-buffer)))
+ (help-setup-xref (list #'describe-categories buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (let* ((table (with-current-buffer buffer (category-table)))
+ (docs (char-table-extra-slot table 0)))
+ (if (or (not (vectorp docs)) (/= (length docs) 95))
+ (error "Invalid first extra slot in this category table\n"))
+ (with-current-buffer standard-output
+ (setq-default help-button-cache (make-marker))
+ (insert "Legend of category mnemonics ")
+ (insert-button "(longer descriptions at the bottom)"
+ 'action help-button-cache
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full legend")
+ (insert "\n")
+ (let ((pos (point)) (items 0) lines n)
+ (dotimes (i 95)
+ (if (aref docs i) (setq items (1+ items))))
+ (setq lines (1+ (/ (1- items) 4)))
+ (setq n 0)
+ (dotimes (i 95)
+ (let ((elt (aref docs i)))
+ (when elt
+ (string-match ".*" elt)
+ (setq elt (match-string 0 elt))
+ (if (>= (length elt) 17)
+ (setq elt (concat (substring elt 0 14) "...")))
+ (if (< (point) (point-max))
+ (move-to-column (* 20 (/ n lines)) t))
+ (insert (+ i ?\s) ?: elt)
+ (if (< (point) (point-max))
+ (forward-line 1)
+ (insert "\n"))
+ (setq n (1+ n))
+ (if (= (% n lines) 0)
+ (goto-char pos))))))
+ (goto-char (point-max))
+ (insert "\n"
+ "character(s)\tcategory mnemonics\n"
+ "------------\t------------------")
+ (describe-vector table 'help-describe-category-set)
+ (set-marker help-button-cache (point))
+ (insert "Legend of category mnemonics:\n")
(dotimes (i 95)
(let ((elt (aref docs i)))
(when elt
- (string-match ".*" elt)
- (setq elt (match-string 0 elt))
- (if (>= (length elt) 17)
- (setq elt (concat (substring elt 0 14) "...")))
- (if (< (point) (point-max))
- (move-to-column (* 20 (/ n lines)) t))
- (insert (+ i ?\s) ?: elt)
- (if (< (point) (point-max))
- (forward-line 1)
- (insert "\n"))
- (setq n (1+ n))
- (if (= (% n lines) 0)
- (goto-char pos))))))
- (goto-char (point-max))
- (insert "\n"
- "character(s)\tcategory mnemonics\n"
- "------------\t------------------")
- (describe-vector table 'help-describe-category-set)
- (set-marker help-button-cache (point))
- (insert "Legend of category mnemonics:\n")
- (dotimes (i 95)
- (let ((elt (aref docs i)))
- (when elt
- (if (string-match "\n" elt)
- (setq elt (substring elt (match-end 0))))
- (insert (+ i ?\s) ": " elt "\n"))))
- (while (setq table (char-table-parent table))
- (insert "\nThe parent category table is:")
- (describe-vector table 'help-describe-category-set))))))
+ (if (string-match "\n" elt)
+ (setq elt (substring elt (match-end 0))))
+ (insert (+ i ?\s) ": " elt "\n"))))
+ (while (setq table (char-table-parent table))
+ (insert "\nThe parent category table is:")
+ (describe-vector table 'help-describe-category-set)))))))
(defun help-fns-find-keymap-name (keymap)
"Find the name of the variable with value KEYMAP.
@@ -1778,7 +1784,8 @@ keymap value."
(unless (and km (keymapp (symbol-value km)))
(user-error "Not a keymap: %s" km))
(list km)))
- (let (used-gentemp)
+ (let (used-gentemp
+ (help-buffer-under-preparation t))
(unless (and (symbolp keymap)
(boundp keymap)
(keymapp (symbol-value keymap)))
@@ -1844,106 +1851,107 @@ whose documentation describes the minor mode.
If called from Lisp with a non-nil BUFFER argument, display
documentation for the major and minor modes of that buffer."
(interactive "@")
- (unless buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-mode buffer)
- (called-interactively-p 'interactive))
- ;; For the sake of help-do-xref and help-xref-go-back,
- ;; don't switch buffers before calling `help-buffer'.
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (let (minors)
- ;; Older packages do not register in minor-mode-list but only in
- ;; minor-mode-alist.
- (dolist (x minor-mode-alist)
- (setq x (car x))
- (unless (memq x minor-mode-list)
- (push x minor-mode-list)))
- ;; Find enabled minor mode we will want to mention.
- (dolist (mode minor-mode-list)
- ;; Document a minor mode if it is listed in minor-mode-alist,
- ;; non-nil, and has a function definition.
- (let ((fmode (or (get mode :minor-mode-function) mode)))
- (and (boundp mode) (symbol-value mode)
- (fboundp fmode)
- (let ((pretty-minor-mode
- (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
- (symbol-name fmode))
- (capitalize
- (substring (symbol-name fmode)
- 0 (match-beginning 0)))
- fmode)))
- (push (list fmode pretty-minor-mode
- (format-mode-line (assq mode minor-mode-alist)))
- minors)))))
- ;; Narrowing is not a minor mode, but its indicator is part of
- ;; mode-line-modes.
- (when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minors))
- (setq minors
- (sort minors
- (lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minors
- (princ "Enabled minor modes:\n")
- (make-local-variable 'help-button-cache)
- (with-current-buffer standard-output
- (dolist (mode minors)
- (let ((mode-function (nth 0 mode))
- (pretty-minor-mode (nth 1 mode))
- (indicator (nth 2 mode)))
- (save-excursion
- (goto-char (point-max))
- (princ "\n\f\n")
- (push (point-marker) help-button-cache)
- ;; Document the minor modes fully.
- (insert-text-button
- pretty-minor-mode 'type 'help-function
- 'help-args (list mode-function)
- 'button '(t))
- (princ (format " minor mode (%s):\n"
- (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s"
- indicator))))
- (princ (help-split-fundoc (documentation mode-function)
- nil 'doc)))
- (insert-button pretty-minor-mode
- 'action (car help-button-cache)
- 'follow-link t
- 'help-echo "mouse-2, RET: show full information")
- (newline)))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-line 1))
-
- (princ "\n(Information about these minor modes follows the major mode
info.)\n\n"))
- ;; Document the major mode.
- (let ((mode mode-name))
- (with-current-buffer standard-output
- (let ((start (point)))
- (insert (format-mode-line mode nil nil buffer))
- (add-text-properties start (point) '(face bold)))))
- (princ " mode")
- (let* ((mode major-mode)
- (file-name (find-lisp-object-file-name mode nil)))
- (if (not file-name)
- (setq help-mode--current-data (list :symbol mode))
- (princ (format-message " defined in `%s'"
- (help-fns-short-filename file-name)))
- ;; Make a hyperlink to the library.
+ (let ((help-buffer-under-preparation t))
+ (unless buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-mode buffer)
+ (called-interactively-p 'interactive))
+ ;; For the sake of help-do-xref and help-xref-go-back,
+ ;; don't switch buffers before calling `help-buffer'.
+ (with-help-window (help-buffer)
+ (with-current-buffer buffer
+ (let (minors)
+ ;; Older packages do not register in minor-mode-list but only in
+ ;; minor-mode-alist.
+ (dolist (x minor-mode-alist)
+ (setq x (car x))
+ (unless (memq x minor-mode-list)
+ (push x minor-mode-list)))
+ ;; Find enabled minor mode we will want to mention.
+ (dolist (mode minor-mode-list)
+ ;; Document a minor mode if it is listed in minor-mode-alist,
+ ;; non-nil, and has a function definition.
+ (let ((fmode (or (get mode :minor-mode-function) mode)))
+ (and (boundp mode) (symbol-value mode)
+ (fboundp fmode)
+ (let ((pretty-minor-mode
+ (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+ (symbol-name fmode))
+ (capitalize
+ (substring (symbol-name fmode)
+ 0 (match-beginning 0)))
+ fmode)))
+ (push (list fmode pretty-minor-mode
+ (format-mode-line (assq mode
minor-mode-alist)))
+ minors)))))
+ ;; Narrowing is not a minor mode, but its indicator is part of
+ ;; mode-line-modes.
+ (when (buffer-narrowed-p)
+ (push '(narrow-to-region "Narrow" " Narrow") minors))
+ (setq minors
+ (sort minors
+ (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+ (when minors
+ (princ "Enabled minor modes:\n")
+ (make-local-variable 'help-button-cache)
(with-current-buffer standard-output
- (save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
- (setq help-mode--current-data (list :symbol mode
- :file file-name))
- (help-xref-button 1 'help-function-def mode file-name)))))
- (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
- (with-current-buffer standard-output
- (insert ":\n")
- (insert fundoc)
- (insert (help-fns--list-local-commands)))))))
- ;; For the sake of IELM and maybe others
- nil)
+ (dolist (mode minors)
+ (let ((mode-function (nth 0 mode))
+ (pretty-minor-mode (nth 1 mode))
+ (indicator (nth 2 mode)))
+ (save-excursion
+ (goto-char (point-max))
+ (princ "\n\f\n")
+ (push (point-marker) help-button-cache)
+ ;; Document the minor modes fully.
+ (insert-text-button
+ pretty-minor-mode 'type 'help-function
+ 'help-args (list mode-function)
+ 'button '(t))
+ (princ (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator))))
+ (princ (help-split-fundoc (documentation mode-function)
+ nil 'doc)))
+ (insert-button pretty-minor-mode
+ 'action (car help-button-cache)
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full
information")
+ (newline)))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-line 1))
+
+ (princ "\n(Information about these minor modes follows the major
mode info.)\n\n"))
+ ;; Document the major mode.
+ (let ((mode mode-name))
+ (with-current-buffer standard-output
+ (let ((start (point)))
+ (insert (format-mode-line mode nil nil buffer))
+ (add-text-properties start (point) '(face bold)))))
+ (princ " mode")
+ (let* ((mode major-mode)
+ (file-name (find-lisp-object-file-name mode nil)))
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol mode))
+ (princ (format-message " defined in `%s'"
+ (help-fns-short-filename file-name)))
+ ;; Make a hyperlink to the library.
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
+ (setq help-mode--current-data (list :symbol mode
+ :file file-name))
+ (help-xref-button 1 'help-function-def mode file-name)))))
+ (let ((fundoc (help-split-fundoc (documentation major-mode) nil
'doc)))
+ (with-current-buffer standard-output
+ (insert ":\n")
+ (insert fundoc)
+ (insert (help-fns--list-local-commands))))))))
+ ;; For the sake of IELM and maybe others
+ nil)
(defun help-fns--list-local-commands ()
(let ((functions nil))
@@ -1998,7 +2006,8 @@ one of them returns non-nil."
(event-end key))
((eq key ?\C-g) (signal 'quit nil))
(t (user-error "You didn't specify a widget"))))))
- (let (buf)
+ (let (buf
+ (help-buffer-under-preparation t))
;; Allow describing a widget in a different window.
(when (posnp pos)
(setq buf (window-buffer (posn-window pos))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 588efee..cd1b51e 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -93,7 +93,8 @@ and then returns."
"Help command."
(interactive)
(let ((line-prompt
- (substitute-command-keys ,help-line)))
+ (substitute-command-keys ,help-line))
+ (help-buffer-under-preparation t))
(when three-step-help
(message "%s" line-prompt))
(let* ((help-screen ,help-text)
diff --git a/lisp/help.el b/lisp/help.el
index 9122d96..1917ef4 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -50,6 +50,11 @@
(defvar help-window-old-frame nil
"Frame selected at the time `with-help-window' is invoked.")
+(defvar help-buffer-under-preparation nil
+ "Whether a *Help* buffer is being prepared.
+This variable is bound to t during the preparation of a *Help*
+buffer.")
+
(defvar help-map
(let ((map (make-sparse-keymap)))
(define-key map (char-to-string help-char) 'help-for-help)
@@ -524,30 +529,31 @@ See `lossage-size' to update the number of recorded
keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
- (help-setup-xref (list #'view-lossage)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (princ " ")
- (princ (mapconcat (lambda (key)
- (cond
- ((and (consp key) (null (car key)))
- (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
- "anonymous-command")))
- ((or (integerp key) (symbolp key) (listp key))
- (single-key-description key))
- (t
- (prin1-to-string key nil))))
- (recent-keys 'include-cmds)
- " "))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (let ((comment-start ";; ")
- (comment-column 24))
- (while (not (eobp))
- (comment-indent)
- (forward-line 1)))
- ;; Show point near the end of "lossage", as we did in Emacs 24.
- (set-marker help-window-point-marker (point)))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'view-lossage)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (princ " ")
+ (princ (mapconcat (lambda (key)
+ (cond
+ ((and (consp key) (null (car key)))
+ (format ";; %s\n" (if (symbolp (cdr key)) (cdr key)
+ "anonymous-command")))
+ ((or (integerp key) (symbolp key) (listp key))
+ (single-key-description key))
+ (t
+ (prin1-to-string key nil))))
+ (recent-keys 'include-cmds)
+ " "))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (let ((comment-start ";; ")
+ (comment-column 24))
+ (while (not (eobp))
+ (comment-indent)
+ (forward-line 1)))
+ ;; Show point near the end of "lossage", as we did in Emacs 24.
+ (set-marker help-window-point-marker (point))))))
;; Key bindings
@@ -579,31 +585,32 @@ The optional argument BUFFER specifies which buffer's
bindings
to display (default, the current buffer). BUFFER can be a buffer
or a buffer name."
(interactive)
- (or buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-bindings prefix buffer)
- (called-interactively-p 'interactive))
- (with-help-window (help-buffer)
- (with-current-buffer (help-buffer)
- (describe-buffer-bindings buffer prefix)
-
- (when describe-bindings-outline
- (setq-local outline-regexp ".*:$")
- (setq-local outline-heading-end-regexp ":\n")
- (setq-local outline-level (lambda () 1))
- (setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
- (setq-local outline-minor-mode-use-buttons t)
- (outline-minor-mode 1)
- (save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- ;; Hide the longest body.
- (when (re-search-forward "Key translations" nil t)
- (outline-hide-subtree))
- ;; Hide ^Ls.
- (while (search-forward "\n\f\n" nil t)
- (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
- 'invisible t))))))))
+ (let ((help-buffer-under-preparation t))
+ (or buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-bindings prefix buffer)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (describe-buffer-bindings buffer prefix)
+
+ (when describe-bindings-outline
+ (setq-local outline-regexp ".*:$")
+ (setq-local outline-heading-end-regexp ":\n")
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t)
+ (setq-local outline-minor-mode-use-buttons t)
+ (outline-minor-mode 1)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ ;; Hide the longest body.
+ (when (re-search-forward "Key translations" nil t)
+ (outline-hide-subtree))
+ ;; Hide ^Ls.
+ (while (search-forward "\n\f\n" nil t)
+ (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
+ 'invisible t)))))))))
(defun where-is (definition &optional insert)
"Print message listing key sequences that invoke the command DEFINITION.
@@ -907,7 +914,8 @@ current buffer."
(let ((raw (if (numberp buffer) (this-single-command-raw-keys) buffer)))
(setf (cdar (last key-list)) raw)))
(setq buffer nil))
- (let* ((buf (or buffer (current-buffer)))
+ (let* ((help-buffer-under-preparation t)
+ (buf (or buffer (current-buffer)))
(on-link
(mapcar (lambda (kr)
(let ((raw (cdr kr)))
@@ -1181,6 +1189,7 @@ Otherwise, return a new string."
(delete-char (- end-point (point)))
(let ((key (help--key-description-fontified key)))
(insert (if (and help-link-key-to-documentation
+ help-buffer-under-preparation
(functionp fun))
;; The `fboundp' fixes bootstrap.
(if (fboundp 'help-mode--add-function-link)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index a4cbf22..7268931 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1638,30 +1638,31 @@ If `default-transient-input-method' was not yet
defined, prompt for it."
(interactive
(list (read-input-method-name
(format-prompt "Describe input method" current-input-method))))
- (if (and input-method (symbolp input-method))
- (setq input-method (symbol-name input-method)))
- (help-setup-xref (list #'describe-input-method
- (or input-method current-input-method))
- (called-interactively-p 'interactive))
-
- (if (null input-method)
- (describe-current-input-method)
- (let ((current current-input-method))
- (condition-case nil
- (progn
- (save-excursion
- (activate-input-method input-method)
- (describe-current-input-method))
- (activate-input-method current))
- (error
- (activate-input-method current)
- (help-setup-xref (list #'describe-input-method input-method)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (let ((elt (assoc input-method input-method-alist)))
- (princ (format-message
- "Input method: %s (`%s' in mode line) for %s\n %s\n"
- input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (and input-method (symbolp input-method))
+ (setq input-method (symbol-name input-method)))
+ (help-setup-xref (list #'describe-input-method
+ (or input-method current-input-method))
+ (called-interactively-p 'interactive))
+
+ (if (null input-method)
+ (describe-current-input-method)
+ (let ((current current-input-method))
+ (condition-case nil
+ (progn
+ (save-excursion
+ (activate-input-method input-method)
+ (describe-current-input-method))
+ (activate-input-method current))
+ (error
+ (activate-input-method current)
+ (help-setup-xref (list #'describe-input-method input-method)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (let ((elt (assoc input-method input-method-alist)))
+ (princ (format-message
+ "Input method: %s (`%s' in mode line) for %s\n %s\n"
+ input-method (nth 3 elt) (nth 1 elt) (nth 4
elt)))))))))))
(defun describe-current-input-method ()
"Describe the input method currently in use.
@@ -2162,89 +2163,90 @@ See `set-language-info-alist' for use in programs."
(list (read-language-name
'documentation
(format-prompt "Describe language environment"
current-language-environment))))
- (if (null language-name)
- (setq language-name current-language-environment))
- (if (or (null language-name)
- (null (get-language-info language-name 'documentation)))
- (error "No documentation for the specified language"))
- (if (symbolp language-name)
- (setq language-name (symbol-name language-name)))
- (dolist (feature (get-language-info language-name 'features))
- (require feature))
- (let ((doc (get-language-info language-name 'documentation)))
- (help-setup-xref (list #'describe-language-environment language-name)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert language-name " language environment\n\n")
- (if (stringp doc)
- (insert (substitute-command-keys doc) "\n\n"))
- (condition-case nil
- (let ((str (eval (get-language-info language-name 'sample-text))))
- (if (stringp str)
- (insert "Sample text:\n "
- (string-replace "\n" "\n " str)
- "\n\n")))
- (error nil))
- (let ((input-method (get-language-info language-name 'input-method))
- (l (copy-sequence input-method-alist))
- (first t))
- (when (and input-method
- (setq input-method (assoc input-method l)))
- (insert "Input methods (default " (car input-method) ")\n")
- (setq l (cons input-method (delete input-method l))
- first nil))
- (dolist (elt l)
- (when (or (eq input-method elt)
- (eq t (compare-strings language-name nil nil
- (nth 1 elt) nil nil t)))
- (when first
- (insert "Input methods:\n")
- (setq first nil))
- (insert " " (car elt))
- (search-backward (car elt))
- (help-xref-button 0 'help-input-method (car elt))
- (goto-char (point-max))
- (insert " (\""
- (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
- "\" in mode line)\n")))
- (or first
- (insert "\n")))
- (insert "Character sets:\n")
- (let ((l (get-language-info language-name 'charset)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-character-set (car l))
- (goto-char (point-max))
- (insert ": " (charset-description (car l)) "\n")
- (setq l (cdr l)))))
- (insert "\n")
- (insert "Coding systems:\n")
- (let ((l (get-language-info language-name 'coding-system)))
- (if (null l)
- (insert " nothing specific to " language-name "\n")
- (while l
- (insert " " (symbol-name (car l)))
- (search-backward (symbol-name (car l)))
- (help-xref-button 0 'help-coding-system (car l))
- (goto-char (point-max))
- (insert (substitute-command-keys " (`")
- (coding-system-mnemonic (car l))
- (substitute-command-keys "' in mode line):\n\t")
- (substitute-command-keys
- (coding-system-doc-string (car l)))
- "\n")
- (let ((aliases (coding-system-aliases (car l))))
- (when aliases
- (insert "\t(alias:")
- (while aliases
- (insert " " (symbol-name (car aliases)))
- (setq aliases (cdr aliases)))
- (insert ")\n")))
- (setq l (cdr l)))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (null language-name)
+ (setq language-name current-language-environment))
+ (if (or (null language-name)
+ (null (get-language-info language-name 'documentation)))
+ (error "No documentation for the specified language"))
+ (if (symbolp language-name)
+ (setq language-name (symbol-name language-name)))
+ (dolist (feature (get-language-info language-name 'features))
+ (require feature))
+ (let ((doc (get-language-info language-name 'documentation)))
+ (help-setup-xref (list #'describe-language-environment language-name)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert language-name " language environment\n\n")
+ (if (stringp doc)
+ (insert (substitute-command-keys doc) "\n\n"))
+ (condition-case nil
+ (let ((str (eval (get-language-info language-name 'sample-text))))
+ (if (stringp str)
+ (insert "Sample text:\n "
+ (string-replace "\n" "\n " str)
+ "\n\n")))
+ (error nil))
+ (let ((input-method (get-language-info language-name 'input-method))
+ (l (copy-sequence input-method-alist))
+ (first t))
+ (when (and input-method
+ (setq input-method (assoc input-method l)))
+ (insert "Input methods (default " (car input-method) ")\n")
+ (setq l (cons input-method (delete input-method l))
+ first nil))
+ (dolist (elt l)
+ (when (or (eq input-method elt)
+ (eq t (compare-strings language-name nil nil
+ (nth 1 elt) nil nil t)))
+ (when first
+ (insert "Input methods:\n")
+ (setq first nil))
+ (insert " " (car elt))
+ (search-backward (car elt))
+ (help-xref-button 0 'help-input-method (car elt))
+ (goto-char (point-max))
+ (insert " (\""
+ (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
+ "\" in mode line)\n")))
+ (or first
+ (insert "\n")))
+ (insert "Character sets:\n")
+ (let ((l (get-language-info language-name 'charset)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-character-set (car l))
+ (goto-char (point-max))
+ (insert ": " (charset-description (car l)) "\n")
+ (setq l (cdr l)))))
+ (insert "\n")
+ (insert "Coding systems:\n")
+ (let ((l (get-language-info language-name 'coding-system)))
+ (if (null l)
+ (insert " nothing specific to " language-name "\n")
+ (while l
+ (insert " " (symbol-name (car l)))
+ (search-backward (symbol-name (car l)))
+ (help-xref-button 0 'help-coding-system (car l))
+ (goto-char (point-max))
+ (insert (substitute-command-keys " (`")
+ (coding-system-mnemonic (car l))
+ (substitute-command-keys "' in mode line):\n\t")
+ (substitute-command-keys
+ (coding-system-doc-string (car l)))
+ "\n")
+ (let ((aliases (coding-system-aliases (car l))))
+ (when aliases
+ (insert "\t(alias:")
+ (while aliases
+ (insert " " (symbol-name (car aliases)))
+ (setq aliases (cdr aliases)))
+ (insert ")\n")))
+ (setq l (cdr l))))))))))
;;; Locales.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 5cc73e4..efb9296 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -299,65 +299,66 @@ meanings of these arguments."
(defun describe-character-set (charset)
"Display information about built-in character set CHARSET."
(interactive (list (read-charset "Charset: ")))
- (or (charsetp charset)
- (error "Invalid charset: %S" charset))
- (help-setup-xref (list #'describe-character-set charset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert "Character set: " (symbol-name charset))
- (let ((name (get-charset-property charset :name)))
- (if (not (eq name charset))
- (insert " (alias of " (symbol-name name) ?\))))
- (insert "\n\n" (charset-description charset) "\n\n")
- (insert "Number of contained characters: ")
- (dotimes (i (charset-dimension charset))
- (unless (= i 0)
- (insert ?x))
- (insert (format "%d" (charset-chars charset (1+ i)))))
- (insert ?\n)
- (let ((char (charset-iso-final-char charset)))
- (when (> char 0)
- (insert "Final char of ISO2022 designation sequence: ")
- (insert (format-message "`%c'\n" char))))
- (let (aliases)
- (dolist (c charset-list)
- (if (and (not (eq c charset))
- (eq charset (get-charset-property c :name)))
- (push c aliases)))
- (if aliases
- (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
-
- (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
- (:map "Map file: " identity)
- (:unify-map "Unification map file: " identity)
- (:invalid-code
- nil
- ,(lambda (c)
- (format "Invalid character: %c (code %d)" c c)))
- (:emacs-mule-id "Id in emacs-mule coding system: "
- number-to-string)
- (:parents "Parents: "
- (lambda (parents)
- (mapconcat ,(lambda (elt)
- (format "%s" elt))
- parents
- ", ")))
- (:code-space "Code space: " ,(lambda (c)
- (format "%s" c)))
- (:code-offset "Code offset: " number-to-string)
- (:iso-revision-number "ISO revision number: "
- number-to-string)
- (:supplementary-p
- "Used only as a parent or a subset of some other charset,
+ (let ((help-buffer-under-preparation t))
+ (or (charsetp charset)
+ (error "Invalid charset: %S" charset))
+ (help-setup-xref (list #'describe-character-set charset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert "Character set: " (symbol-name charset))
+ (let ((name (get-charset-property charset :name)))
+ (if (not (eq name charset))
+ (insert " (alias of " (symbol-name name) ?\))))
+ (insert "\n\n" (charset-description charset) "\n\n")
+ (insert "Number of contained characters: ")
+ (dotimes (i (charset-dimension charset))
+ (unless (= i 0)
+ (insert ?x))
+ (insert (format "%d" (charset-chars charset (1+ i)))))
+ (insert ?\n)
+ (let ((char (charset-iso-final-char charset)))
+ (when (> char 0)
+ (insert "Final char of ISO2022 designation sequence: ")
+ (insert (format-message "`%c'\n" char))))
+ (let (aliases)
+ (dolist (c charset-list)
+ (if (and (not (eq c charset))
+ (eq charset (get-charset-property c :name)))
+ (push c aliases)))
+ (if aliases
+ (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
+
+ (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
+ (:map "Map file: " identity)
+ (:unify-map "Unification map file: " identity)
+ (:invalid-code
+ nil
+ ,(lambda (c)
+ (format "Invalid character: %c (code %d)" c c)))
+ (:emacs-mule-id "Id in emacs-mule coding system: "
+ number-to-string)
+ (:parents "Parents: "
+ (lambda (parents)
+ (mapconcat ,(lambda (elt)
+ (format "%s" elt))
+ parents
+ ", ")))
+ (:code-space "Code space: " ,(lambda (c)
+ (format "%s" c)))
+ (:code-offset "Code offset: " number-to-string)
+ (:iso-revision-number "ISO revision number: "
+ number-to-string)
+ (:supplementary-p
+ "Used only as a parent or a subset of some other
charset,
or provided just for backward compatibility." nil)))
- (let ((val (get-charset-property charset (car elt))))
- (when val
- (if (cadr elt) (insert (cadr elt)))
- (if (nth 2 elt)
- (let ((print-length 10) (print-level 2))
- (princ (funcall (nth 2 elt) val) (current-buffer))))
- (insert ?\n)))))))
+ (let ((val (get-charset-property charset (car elt))))
+ (when val
+ (if (cadr elt) (insert (cadr elt)))
+ (if (nth 2 elt)
+ (let ((print-length 10) (print-level 2))
+ (princ (funcall (nth 2 elt) val) (current-buffer))))
+ (insert ?\n))))))))
;;; CODING-SYSTEM
@@ -406,89 +407,90 @@ or provided just for backward compatibility." nil)))
(defun describe-coding-system (coding-system)
"Display information about CODING-SYSTEM."
(interactive "zDescribe coding system (default current choices): ")
- (if (null coding-system)
- (describe-current-coding-system)
- (help-setup-xref (list #'describe-coding-system coding-system)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (print-coding-system-briefly coding-system 'doc-string)
- (let ((type (coding-system-type coding-system))
- ;; Fixme: use this
- ;; (extra-spec (coding-system-plist coding-system))
- )
- (princ "Type: ")
- (princ type)
- (cond ((eq type 'undecided)
- (princ " (do automatic conversion)"))
- ((eq type 'utf-8)
- (princ " (UTF-8: Emacs internal multibyte form)"))
- ((eq type 'utf-16)
- ;; (princ " (UTF-16)")
- )
- ((eq type 'shift-jis)
- (princ " (Shift-JIS, MS-KANJI)"))
- ((eq type 'iso-2022)
- (princ " (variant of ISO-2022)\n")
- (princ "Initial designations:\n")
- (print-designation (coding-system-get coding-system
- :designation))
-
- (when (coding-system-get coding-system :flags)
- (princ "Other specifications: \n ")
- (apply #'print-list
- (coding-system-get coding-system :flags))))
- ((eq type 'charset)
- (princ " (charset)"))
- ((eq type 'ccl)
- (princ " (do conversion by CCL program)"))
- ((eq type 'raw-text)
- (princ " (text with random binary characters)"))
- ((eq type 'emacs-mule)
- (princ " (Emacs 21 internal encoding)"))
- ((eq type 'big5))
- (t (princ ": invalid coding-system.")))
- (princ "\nEOL type: ")
- (let ((eol-type (coding-system-eol-type coding-system)))
- (cond ((vectorp eol-type)
- (princ "Automatic selection from:\n\t")
- (princ eol-type)
- (princ "\n"))
- ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
- ((eq eol-type 1) (princ "CRLF\n"))
- ((eq eol-type 2) (princ "CR\n"))
- (t (princ "invalid\n")))))
- (let ((postread (coding-system-get coding-system :post-read-conversion)))
- (when postread
- (princ "After decoding text normally,")
- (princ " perform post-conversion using the function: ")
- (princ "\n ")
- (princ postread)
- (princ "\n")))
- (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
- (when prewrite
- (princ "Before encoding text normally,")
- (princ " perform pre-conversion using the function: ")
- (princ "\n ")
- (princ prewrite)
- (princ "\n")))
- (with-current-buffer standard-output
- (let ((charsets (coding-system-charset-list coding-system)))
- (when (and (not (eq (coding-system-base coding-system) 'raw-text))
- charsets)
- (cond
- ((eq charsets 'iso-2022)
- (insert "This coding system can encode all ISO 2022 charsets."))
- ((eq charsets 'emacs-mule)
- (insert "This coding system can encode all emacs-mule charsets\
+ (let ((help-buffer-under-preparation t))
+ (if (null coding-system)
+ (describe-current-coding-system)
+ (help-setup-xref (list #'describe-coding-system coding-system)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (print-coding-system-briefly coding-system 'doc-string)
+ (let ((type (coding-system-type coding-system))
+ ;; Fixme: use this
+ ;; (extra-spec (coding-system-plist coding-system))
+ )
+ (princ "Type: ")
+ (princ type)
+ (cond ((eq type 'undecided)
+ (princ " (do automatic conversion)"))
+ ((eq type 'utf-8)
+ (princ " (UTF-8: Emacs internal multibyte form)"))
+ ((eq type 'utf-16)
+ ;; (princ " (UTF-16)")
+ )
+ ((eq type 'shift-jis)
+ (princ " (Shift-JIS, MS-KANJI)"))
+ ((eq type 'iso-2022)
+ (princ " (variant of ISO-2022)\n")
+ (princ "Initial designations:\n")
+ (print-designation (coding-system-get coding-system
+ :designation))
+
+ (when (coding-system-get coding-system :flags)
+ (princ "Other specifications: \n ")
+ (apply #'print-list
+ (coding-system-get coding-system :flags))))
+ ((eq type 'charset)
+ (princ " (charset)"))
+ ((eq type 'ccl)
+ (princ " (do conversion by CCL program)"))
+ ((eq type 'raw-text)
+ (princ " (text with random binary characters)"))
+ ((eq type 'emacs-mule)
+ (princ " (Emacs 21 internal encoding)"))
+ ((eq type 'big5))
+ (t (princ ": invalid coding-system.")))
+ (princ "\nEOL type: ")
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (cond ((vectorp eol-type)
+ (princ "Automatic selection from:\n\t")
+ (princ eol-type)
+ (princ "\n"))
+ ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
+ ((eq eol-type 1) (princ "CRLF\n"))
+ ((eq eol-type 2) (princ "CR\n"))
+ (t (princ "invalid\n")))))
+ (let ((postread (coding-system-get coding-system
:post-read-conversion)))
+ (when postread
+ (princ "After decoding text normally,")
+ (princ " perform post-conversion using the function: ")
+ (princ "\n ")
+ (princ postread)
+ (princ "\n")))
+ (let ((prewrite (coding-system-get coding-system
:pre-write-conversion)))
+ (when prewrite
+ (princ "Before encoding text normally,")
+ (princ " perform pre-conversion using the function: ")
+ (princ "\n ")
+ (princ prewrite)
+ (princ "\n")))
+ (with-current-buffer standard-output
+ (let ((charsets (coding-system-charset-list coding-system)))
+ (when (and (not (eq (coding-system-base coding-system) 'raw-text))
+ charsets)
+ (cond
+ ((eq charsets 'iso-2022)
+ (insert "This coding system can encode all ISO 2022 charsets."))
+ ((eq charsets 'emacs-mule)
+ (insert "This coding system can encode all emacs-mule charsets\
."""))
- (t
- (insert "This coding system encodes the following charsets:\n ")
- (while charsets
- (insert " " (symbol-name (car charsets)))
- (search-backward (symbol-name (car charsets)))
- (help-xref-button 0 'help-character-set (car charsets))
- (goto-char (point-max))
- (setq charsets (cdr charsets)))))))))))
+ (t
+ (insert "This coding system encodes the following charsets:\n ")
+ (while charsets
+ (insert " " (symbol-name (car charsets)))
+ (search-backward (symbol-name (car charsets)))
+ (help-xref-button 0 'help-character-set (car charsets))
+ (goto-char (point-max))
+ (setq charsets (cdr charsets))))))))))))
;;;###autoload
(defun describe-current-coding-system-briefly ()
@@ -845,7 +847,8 @@ The IGNORED argument is ignored."
(or (and window-system (fboundp 'fontset-list))
(error "No fonts being used"))
(let ((xref-item (list #'describe-font fontname))
- font-info)
+ font-info
+ (help-buffer-under-preparation t))
(if (or (not fontname) (= (length fontname) 0))
(setq fontname (face-attribute 'default :font)))
(setq font-info (font-info fontname))
@@ -1006,14 +1009,15 @@ This shows which font is used for which character(s)."
(list (completing-read
(format-prompt "Fontset" "used by the current frame")
fontset-list nil t)))))
- (if (= (length fontset) 0)
- (setq fontset (face-attribute 'default :fontset))
- (setq fontset (query-fontset fontset)))
- (help-setup-xref (list #'describe-fontset fontset)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (print-fontset fontset t))))
+ (let ((help-buffer-under-preparation t))
+ (if (= (length fontset) 0)
+ (setq fontset (face-attribute 'default :fontset))
+ (setq fontset (query-fontset fontset)))
+ (help-setup-xref (list #'describe-fontset fontset)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (print-fontset fontset t)))))
(declare-function fontset-plain-name "fontset" (fontset))
@@ -1024,39 +1028,41 @@ This shows the name, size, and style of each fontset.
With prefix arg, also list the fonts contained in each fontset;
see the function `describe-fontset' for the format of the list."
(interactive "P")
- (if (not (and window-system (fboundp 'fontset-list)))
- (error "No fontsets being used")
- (help-setup-xref (list #'list-fontsets arg)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- ;; This code is duplicated near the end of mule-diag.
- (let ((fontsets
- (sort (fontset-list)
- (lambda (x y)
- (string< (fontset-plain-name x)
- (fontset-plain-name y))))))
- (while fontsets
- (if arg
- (print-fontset (car fontsets) nil)
- (insert "Fontset: " (car fontsets) "\n"))
- (setq fontsets (cdr fontsets))))))))
+ (let ((help-buffer-under-preparation t))
+ (if (not (and window-system (fboundp 'fontset-list)))
+ (error "No fontsets being used")
+ (help-setup-xref (list #'list-fontsets arg)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ ;; This code is duplicated near the end of mule-diag.
+ (let ((fontsets
+ (sort (fontset-list)
+ (lambda (x y)
+ (string< (fontset-plain-name x)
+ (fontset-plain-name y))))))
+ (while fontsets
+ (if arg
+ (print-fontset (car fontsets) nil)
+ (insert "Fontset: " (car fontsets) "\n"))
+ (setq fontsets (cdr fontsets)))))))))
;;;###autoload
(defun list-input-methods ()
"Display information about all input methods."
(interactive)
- (help-setup-xref '(list-input-methods)
- (called-interactively-p 'interactive))
- (with-output-to-temp-buffer (help-buffer)
- (list-input-methods-1)
- (with-current-buffer standard-output
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode line)$")
- nil t)
- (help-xref-button 1 'help-input-method (match-string 1)))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref '(list-input-methods)
+ (called-interactively-p 'interactive))
+ (with-output-to-temp-buffer (help-buffer)
+ (list-input-methods-1)
+ (with-current-buffer standard-output
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode
line)$")
+ nil t)
+ (help-xref-button 1 'help-input-method (match-string 1))))))))
(defun list-input-methods-1 ()
(if (not input-method-alist)
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 770a6ed..07e43c3 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -58,6 +58,11 @@ DEFINITION is anything that can be a key's definition:
(See info node `(elisp)Extended Menu Items'.)"
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
+ ;; If we're binding this key to another key, then parse that other
+ ;; key, too.
+ (when (stringp definition)
+ (keymap--check definition)
+ (setq definition (key-parse definition)))
(define-key keymap (key-parse key) definition))
(defun keymap-global-set (key command)
@@ -143,8 +148,6 @@ If you don't specify OLDMAP, you can usually get the same
results
in a cleaner way with command remapping, like this:
(define-key KEYMAP [remap OLDDEF] NEWDEF)
\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
- (declare (compiler-macro
- (lambda (form) (keymap--compile-check olddef newdef) form)))
;; Don't document PREFIX in the doc string because we don't want to
;; advertise it. It's meant for recursive calls only. Here's its
;; meaning
@@ -154,10 +157,6 @@ in a cleaner way with command remapping, like this:
;; original key, with PREFIX added at the front.
(unless prefix
(setq prefix ""))
- (keymap--check olddef)
- (keymap--check newdef)
- (setq olddef (key-parse olddef))
- (setq newdef (key-parse newdef))
(let* ((scan (or oldmap keymap))
(prefix1 (vconcat prefix [nil]))
(key-substitution-in-progress
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 613d973..af53e9b 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -2811,6 +2811,13 @@ used instead of `browse-url-new-window-flag'.
(make-obsolete 'browse-url-galeon 'nil '"25.1")
+(autoload 'browse-url-webpositive "browse-url" "\
+Ask the WebPositive WWW browser to load URL.
+Default to the URL around or before point.
+The optional argument NEW-WINDOW is not used.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
+
(autoload 'browse-url-emacs "browse-url" "\
Ask Emacs to load URL into a buffer and show it in another window.
Optional argument SAME-WINDOW non-nil means show the URL in the
@@ -17342,9 +17349,7 @@ inlined into the compiled format versions. This means
that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-column 'lisp-indent-function 'defun)
+\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
@@ -17356,11 +17361,7 @@ For sorting, the forms in BODY will be evaluated with
`a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-sorter 'lisp-indent-function '1)
-
-(function-put 'define-ibuffer-sorter 'doc-string-elt '2)
+\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
@@ -17400,11 +17401,7 @@ BODY define the operation; they are forms to evaluate
per each
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
-\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS
OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-op 'lisp-indent-function '2)
-
-(function-put 'define-ibuffer-op 'doc-string-elt '3)
+\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS
OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
@@ -17420,11 +17417,7 @@ not a particular buffer should be displayed or not.
The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t)
-
-(function-put 'define-ibuffer-filter 'lisp-indent-function '2)
-
-(function-put 'define-ibuffer-filter 'doc-string-elt '2)
+\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro)
(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
@@ -19542,24 +19535,24 @@ Display a list of the options available when a
misspelling is encountered.
Selections are:
-DIGIT: Replace the word with a digit offered in the *Choices* buffer.
-SPC: Accept word this time.
-`i': Accept word and insert into private dictionary.
-`a': Accept word for this session.
-`A': Accept word and place in `buffer-local dictionary'.
-`r': Replace word with typed-in value. Rechecked.
-`R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-`?': Show these commands.
-`x': Exit spelling buffer. Move cursor to original point.
-`X': Exit spelling buffer. Leaves cursor at the current point, and permits
+\\`0'..\\`9' Replace the word with a digit offered in the *Choices* buffer.
+\\`SPC' Accept word this time.
+\\`i' Accept word and insert into private dictionary.
+\\`a' Accept word for this session.
+\\`A' Accept word and place in `buffer-local dictionary'.
+\\`r' Replace word with typed-in value. Rechecked.
+\\`R' Replace word with typed-in value. Query-replaced in buffer.
Rechecked.
+\\`?' Show these commands.
+\\`x' Exit spelling buffer. Move cursor to original point.
+\\`X' Exit spelling buffer. Leaves cursor at the current point, and
permits
the aborted check to be completed later.
-`q': Quit spelling session (Kills ispell process).
-`l': Look up typed-in replacement in alternate dictionary. Wildcards okay.
-`u': Like `i', but the word is lower-cased first.
-`m': Place typed-in value in personal dictionary, then recheck current word.
-`C-l': Redraw screen.
-`C-r': Recursive edit.
-`C-z': Suspend Emacs or iconify frame." nil nil)
+\\`q' Quit spelling session (Kills ispell process).
+\\`l' Look up typed-in replacement in alternate dictionary. Wildcards
okay.
+\\`u' Like \\`i', but the word is lower-cased first.
+\\`m' Place typed-in value in personal dictionary, then recheck current
word.
+\\`C-l' Redraw screen.
+\\`C-r' Recursive edit.
+\\`C-z' Suspend Emacs or iconify frame." nil nil)
(autoload 'ispell-kill-ispell "ispell" "\
Kill current Ispell process (so that you may start a fresh one).
@@ -19666,8 +19659,8 @@ Don't check spelling of message headers except the
Subject field.
Don't check included messages.
To abort spell checking of a message region and send the message anyway,
-use the `x' command. (Any subsequent regions will be checked.)
-The `X' command aborts sending the message so that you can edit the buffer.
+use the \\`x' command. (Any subsequent regions will be checked.)
+The \\`X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
in your init file:
@@ -21025,7 +21018,7 @@ current header, calls `mail-complete-function' and
passes prefix ARG if any.
;;; Generated autoloads from net/mailcap.el
(autoload 'mailcap-mime-type-to-extension "mailcap" "\
-Return a file name extension based on a mime type.
+Return a file name extension based on a MIME-TYPE.
For instance, `image/png' will result in `png'.
\(fn MIME-TYPE)" nil nil)
@@ -24164,7 +24157,7 @@ Coloring:
;;;### (autoloads nil "org" "org/org.el" (0 0 0 0))
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 5)) package--builtin-versions)
+(push (purecopy '(org 9 5 1)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -25900,6 +25893,38 @@ disabled.
\(fn &optional ARG)" t nil)
+(defvar pixel-scroll-precision-mode nil "\
+Non-nil if Pixel-Scroll-Precision mode is enabled.
+See the `pixel-scroll-precision-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `pixel-scroll-precision-mode'.")
+
+(custom-autoload 'pixel-scroll-precision-mode "pixel-scroll" nil)
+
+(autoload 'pixel-scroll-precision-mode "pixel-scroll" "\
+Toggle pixel scrolling.
+When enabled, this minor mode allows to scroll the display
+precisely, according to the turning of the mouse wheel.
+
+This is a minor mode. If called interactively, toggle the
+`Pixel-Scroll-Precision mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value \\='pixel-scroll-precision-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
(register-definition-prefixes "pixel-scroll" '("pixel-"))
;;;***
@@ -27680,11 +27705,11 @@ If ARG is non-nil, instead prompt for connection
parameters.
(autoload 'rcirc-connect "rcirc" "\
Connect to SERVER.
The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
-ENCRYPTION, SERVER-ALIAS are interpreted as in
+ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in
`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
that are joined after authentication.
-\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD
ENCRYPTION SERVER-ALIAS)" nil nil)
+\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD
ENCRYPTION CERTFP SERVER-ALIAS)" nil nil)
(defvar rcirc-track-minor-mode nil "\
Non-nil if Rcirc-Track minor mode is enabled.
@@ -32539,6 +32564,16 @@ This takes into account combining characters and
grapheme clusters.
\(fn STRING)" nil nil)
+(autoload 'add-display-text-property "subr-x" "\
+Add display property PROP with VALUE to the text from START to END.
+If any text in the region has a non-nil `display' property, those
+properties are retained.
+
+If OBJECT is non-nil, it should be a string or a buffer. If nil,
+this defaults to the current buffer.
+
+\(fn START END PROP VALUE &optional OBJECT)" nil nil)
+
(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*"
"internal--" "named-let" "replace-region-contents" "string-" "thread-"
"when-let*" "with-memoization"))
;;;***
@@ -35583,16 +35618,20 @@ You might need to set `uce-mail-reader' before using
this.
;;; Generated autoloads from international/ucs-normalize.el
(autoload 'string-glyph-compose "ucs-normalize" "\
-Compose the string STR by according to the Unicode NFC.
-This is the canonical composed form. For instance:
+Compose STRING according to the Unicode NFC.
+This returns a new string obtained by canonical decomposition
+of STRING (see `ucs-normalize-NFC-string') followed by canonical
+composition, a.k.a. the \"Unicode Normalization Form C\" of STRING.
+For instance:
- (ucs-normalize-NFC-string \"Å\") => \"Å\"
+ (string-glyph-compose \"Å\") => \"Å\"
\(fn STRING)" nil nil)
(autoload 'string-glyph-decompose "ucs-normalize" "\
-Decompose the string STR according to the Unicode NFD.
-This is the canonical decomposed form. For instance:
+Decompose STRING according to the Unicode NFD.
+This returns a new string that is the canonical decomposition of STRING,
+a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance:
(ucs-normalize-NFD-string \"Å\") => \"Å\"
@@ -36460,7 +36499,7 @@ Report an ERROR that occurred while unlocking a file.
\(fn ERROR)" nil nil)
-(register-definition-prefixes "userlock" '("ask-user-about-" "file-"
"userlock--"))
+(register-definition-prefixes "userlock" '("ask-user-about-" "file-"
"userlock--check-content-unchanged"))
;;;***
@@ -39173,7 +39212,7 @@ where PREFIX is a prefix key and MODIFIERS is either a
list of modifiers or
a single modifier.
If PREFIX is `none', no prefix is used. If MODIFIERS is `none',
the keybindings are directly bound to the arrow keys.
-Default value of PREFIX is `C-x' and MODIFIERS is `shift'.
+Default value of PREFIX is \\`C-x' and MODIFIERS is `shift'.
\(fn &optional PREFIX MODIFIERS)" t nil)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index d59b0ed..5d38a7e 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -40,6 +40,7 @@
(require 'image)
(require 'puny)
(require 'url-cookie)
+(require 'pixel-fill)
(require 'text-property-search)
(defgroup shr nil
@@ -240,7 +241,6 @@ and other things:
(defvar shr-internal-width nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
-(defvar shr-kinsoku-shorten nil)
(defvar shr-table-depth 0)
(defvar shr-stylesheet nil)
(defvar shr-base nil)
@@ -641,28 +641,6 @@ size, and full-buffer size."
(shr-fill-lines (point-min) (point-max))
(buffer-string)))))
-(define-inline shr-char-breakable-p (char)
- "Return non-nil if a line can be broken before and after CHAR."
- (inline-quote (aref fill-find-break-point-function-table ,char)))
-(define-inline shr-char-nospace-p (char)
- "Return non-nil if no space is required before and after CHAR."
- (inline-quote (aref fill-nospace-between-words-table ,char)))
-
-;; KINSOKU is a Japanese word meaning a rule that should not be violated.
-;; In Emacs, it is a term used for characters, e.g. punctuation marks,
-;; parentheses, and so on, that should not be placed in the beginning
-;; of a line or the end of a line.
-(define-inline shr-char-kinsoku-bol-p (char)
- "Return non-nil if a line ought not to begin with CHAR."
- (inline-letevals (char)
- (inline-quote (and (not (eq ,char ?'))
- (aref (char-category-set ,char) ?>)))))
-(define-inline shr-char-kinsoku-eol-p (char)
- "Return non-nil if a line ought not to end with CHAR."
- (inline-quote (aref (char-category-set ,char) ?<)))
-(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
- (load "kinsoku" nil t))
-
(defun shr-pixel-column ()
(if (not shr-use-fonts)
(current-column)
@@ -676,6 +654,7 @@ size, and full-buffer size."
(car (window-text-pixel-size nil (line-beginning-position) (point))))))
(defun shr-pixel-region ()
+ (declare (obsolete nil "29.1"))
(- (shr-pixel-column)
(save-excursion
(goto-char (mark))
@@ -795,7 +774,7 @@ size, and full-buffer size."
(while (not (eolp))
;; We have to do some folding. First find the first
;; previous point suitable for folding.
- (if (or (not (shr-find-fill-point (line-beginning-position)))
+ (if (or (not (pixel-fill-find-fill-point (line-beginning-position)))
(= (point) start))
;; We had unbreakable text (for this width), so just go to
;; the first space and carry on.
@@ -836,84 +815,6 @@ size, and full-buffer size."
(when (looking-at " $")
(delete-region (point) (line-end-position)))))))
-(defun shr-find-fill-point (start)
- (let ((bp (point))
- (end (point))
- failed)
- (while (not (or (setq failed (<= (point) start))
- (eq (preceding-char) ? )
- (eq (following-char) ? )
- (shr-char-breakable-p (preceding-char))
- (shr-char-breakable-p (following-char))
- (and (shr-char-kinsoku-bol-p (preceding-char))
- (shr-char-breakable-p (following-char))
- (not (shr-char-kinsoku-bol-p (following-char))))
- (shr-char-kinsoku-eol-p (following-char))
- (bolp)))
- (backward-char 1))
- (if failed
- ;; There's no breakable point, so we give it up.
- (let (found)
- (goto-char bp)
- ;; Don't overflow the window edge, even if
- ;; shr-kinsoku-shorten is nil.
- (unless (or shr-kinsoku-shorten (null shr-width))
- (while (setq found (re-search-forward
- "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
- (line-end-position) 'move)))
- (if (and found
- (not (match-beginning 1)))
- (goto-char (match-beginning 0)))))
- (or
- (eolp)
- ;; Don't put kinsoku-bol characters at the beginning of a line,
- ;; or kinsoku-eol characters at the end of a line.
- (cond
- ;; Don't overflow the window edge, even if shr-kinsoku-shorten
- ;; is nil.
- ((or shr-kinsoku-shorten (null shr-width))
- (while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char))))
- (backward-char 1))
- (when (setq failed (<= (point) start))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we look for the second best position.
- (while (and (progn
- (forward-char 1)
- (<= (point) end))
- (progn
- (setq bp (point))
- (shr-char-kinsoku-eol-p (following-char)))))
- (goto-char bp)))
- ((shr-char-kinsoku-eol-p (preceding-char))
- ;; Find backward the point where kinsoku-eol characters begin.
- (let ((count 4))
- (while
- (progn
- (backward-char 1)
- (and (> (setq count (1- count)) 0)
- (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char)))))))
- (when (setq failed (<= (point) start))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1))))
- ((shr-char-kinsoku-bol-p (following-char))
- ;; Find forward the point where kinsoku-bol characters end.
- (let ((count 4))
- (while (progn
- (forward-char 1)
- (and (>= (setq count (1- count)) 0)
- (shr-char-kinsoku-bol-p (following-char))
- (shr-char-breakable-p (following-char))))))))
- (when (eq (following-char) ? )
- (forward-char 1))))
- (not failed)))
-
(defun shr-parse-base (url)
;; Always chop off anchors.
(when (string-match "#.*" url)
@@ -2077,7 +1978,8 @@ BASE is the URL of the HTML being rendered."
(setq dom (or (dom-child-by-tag dom 'tbody) dom))
(let* ((shr-inhibit-images t)
(shr-table-depth (1+ shr-table-depth))
- (shr-kinsoku-shorten t)
+ ;; Fill hard in CJK languages.
+ (pixel-fill-respect-kinsoku nil)
;; Find all suggested widths.
(columns (shr-column-specs dom))
;; Compute how many pixels wide each TD should be.
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ed076a6..c2e125a 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1210,6 +1210,15 @@ current project, it will be killed."
:group 'project
:package-version '(project . "0.6.0"))
+(defcustom project-kill-buffers-display-buffer-list nil
+ "Non-nil to display list of buffers to kill before killing project buffers.
+Used by `project-kill-buffers'."
+ :type 'boolean
+ :version "29.1"
+ :group 'project
+ :package-version '(project . "0.8.1")
+ :safe #'booleanp)
+
(defun project--buffer-list (pr)
"Return the list of all buffers in project PR."
(let ((conn (file-remote-p (project-root pr)))
@@ -1276,14 +1285,35 @@ NO-CONFIRM is always nil when the command is invoked
interactively."
(interactive)
(let* ((pr (project-current t))
- (bufs (project--buffers-to-kill pr)))
+ (bufs (project--buffers-to-kill pr))
+ (query-user (lambda ()
+ (yes-or-no-p
+ (format "Kill %d buffers in %s? "
+ (length bufs)
+ (project-root pr))))))
(cond (no-confirm
(mapc #'kill-buffer bufs))
((null bufs)
(message "No buffers to kill"))
- ((yes-or-no-p (format "Kill %d buffers in %s? "
- (length bufs)
- (project-root pr)))
+ (project-kill-buffers-display-buffer-list
+ (when
+ (with-current-buffer-window
+ (get-buffer-create "*Buffer List*")
+ `(display-buffer--maybe-at-bottom
+ (dedicated . t)
+ (window-height . (fit-window-to-buffer))
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ (list-buffers-noselect nil bufs))))
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (funcall query-user)
+ (when (window-live-p window)
+ (quit-restore-window window 'kill))))))
+ (mapc #'kill-buffer bufs)))
+ ((funcall query-user)
(mapc #'kill-buffer bufs)))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 32ffb18..7bbb398 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -515,31 +515,32 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
Used in `repeat-mode'."
(interactive)
(require 'help-fns)
- (help-setup-xref (list #'describe-repeat-maps)
- (called-interactively-p 'interactive))
- (let ((keymaps nil))
- (all-completions
- "" obarray (lambda (s)
- (and (commandp s)
- (get s 'repeat-map)
- (push s (alist-get (get s 'repeat-map) keymaps)))))
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (princ "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
-
- (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car
b)))))
- (princ (format-message "`%s' keymap is repeatable by these
commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) 'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (symbol-value (car keymap))))
- (desc (mapconcat (lambda (key)
- (format-message "`%s'" (key-description
key)))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (princ (format-message " `%s' (bound to %s)\n" command desc))))
- (princ "\n"))))))
+ (let ((help-buffer-under-preparation t))
+ (help-setup-xref (list #'describe-repeat-maps)
+ (called-interactively-p 'interactive))
+ (let ((keymaps nil))
+ (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push s (alist-get (get s 'repeat-map) keymaps)))))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (princ "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
+
+ (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a)
(car b)))))
+ (princ (format-message "`%s' keymap is repeatable by these
commands:\n"
+ (car keymap)))
+ (dolist (command (sort (cdr keymap) 'string-lessp))
+ (let* ((info (help-fns--analyze-function command))
+ (map (list (symbol-value (car keymap))))
+ (desc (mapconcat (lambda (key)
+ (format-message "`%s'"
(key-description key)))
+ (or (where-is-internal command map)
+ (where-is-internal (nth 3 info) map))
+ ", ")))
+ (princ (format-message " `%s' (bound to %s)\n" command desc))))
+ (princ "\n")))))))
(provide 'repeat)
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 73d76a8..4e16109 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -705,7 +705,10 @@ space does not end a sentence, so don't break a line
there."
(goto-char from-plus-indent))
(if (not (> to (point)))
- nil ;; There is no paragraph, only whitespace: exit now.
+ ;; There is no paragraph, only whitespace: exit now.
+ (progn
+ (set-marker to nil)
+ nil)
(or justify (setq justify (current-justification)))
@@ -791,6 +794,7 @@ space does not end a sentence, so don't break a line there."
;; Leave point after final newline.
(goto-char to)
(unless (eobp) (forward-char 1))
+ (set-marker to nil)
;; Return the fill-prefix we used
fill-prefix)))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 4087f7e..754ecb3 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -3977,7 +3977,7 @@ You can bind this to the key C-c i in GNUS or mail by
adding to
(if (re-search-forward "^Subject: *" end-of-headers t)
(progn
(goto-char (match-end 0))
- (if (and (not (looking-at ".*Re\\>"))
+ (if (and (not (looking-at ".*\\<Re\\>"))
(not (looking-at "\\[")))
(progn
(setq case-fold-search old-case-fold-search)
diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el
new file mode 100644
index 0000000..eff09df
--- /dev/null
+++ b/lisp/textmodes/pixel-fill.el
@@ -0,0 +1,202 @@
+;;; pixel-fill.el --- variable pitch filling functions -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: filling
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The main entry point is `pixel-fill-region', but
+;; `pixel-fill-find-fill-point' can also be useful by itself.
+
+;;; Code:
+
+(require 'kinsoku)
+
+(defgroup pixel-fill nil
+ "Filling based on pixel widths."
+ :group 'fill
+ :version "29.1")
+
+(defcustom pixel-fill-respect-kinsoku t
+ "If nil, fill even if we can't find a good kinsoku point.
+Kinsoku is a Japanese word meaning a rule that should not be violated.
+In Emacs, it is a term used for characters, e.g. punctuation marks,
+parentheses, and so on, that should not be placed in the beginning
+of a line or the end of a line."
+ :type 'boolean
+ :version "29.1")
+
+(defun pixel-fill-region (start end pixel-width)
+ "Fill the region between START and END.
+This will attempt to reformat the text in the region to have no
+lines that are visually wider than PIXEL-WIDTH.
+
+If START isn't at the start of a line, that pixel position will
+be used as the indentation prefix on subsequent lines."
+ (save-excursion
+ (goto-char start)
+ (let ((indentation
+ (car (window-text-pixel-size nil (line-beginning-position)
+ (point)))))
+ (when (> indentation pixel-width)
+ (error "The indentation (%s) is wider than the fill width (%s)"
+ indentation pixel-width))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ ;; First replace all whitespace with space.
+ (while (re-search-forward "[ \t\n]+" nil t)
+ (if (= (match-beginning 0) start)
+ (delete-region (match-beginning 0) (match-end 0))
+ (replace-match " ")))
+ (goto-char start)
+ (pixel-fill--fill-line pixel-width indentation)))))
+
+(defun pixel-fill--goto-pixel (width)
+ (vertical-motion (cons (/ width (frame-char-width)) 0)))
+
+(defun pixel-fill--fill-line (width &optional indentation)
+ (let ((start (point)))
+ (pixel-fill--goto-pixel width)
+ (while (not (eolp))
+ ;; We have to do some folding. First find the first previous
+ ;; point suitable for folding.
+ (if (or (not (pixel-fill-find-fill-point (line-beginning-position)))
+ (= (point) start))
+ ;; We had unbreakable text (for this width), so just go to
+ ;; the first space and carry on.
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (search-forward " " (line-end-position) 'move)))
+ ;; Success; continue.
+ (when (= (preceding-char) ?\s)
+ (delete-char -1))
+ (insert ?\n)
+ (when (> indentation 0)
+ (insert (propertize " " 'display
+ (list 'space :align-to (list indentation)))))
+ (setq start (point))
+ (pixel-fill--goto-pixel width))))
+
+(define-inline pixel-fill--char-breakable-p (char)
+ "Return non-nil if a line can be broken before and after CHAR."
+ (inline-quote (aref fill-find-break-point-function-table ,char)))
+
+(define-inline pixel-fill--char-nospace-p (char)
+ "Return non-nil if no space is required before and after CHAR."
+ (inline-quote (aref fill-nospace-between-words-table ,char)))
+
+(define-inline pixel-fill--char-kinsoku-bol-p (char)
+ "Return non-nil if a line ought not to begin with CHAR."
+ (inline-letevals (char)
+ (inline-quote (and (not (eq ,char ?'))
+ (aref (char-category-set ,char) ?>)))))
+
+(define-inline pixel-fill--char-kinsoku-eol-p (char)
+ "Return non-nil if a line ought not to end with CHAR."
+ (inline-quote (aref (char-category-set ,char) ?<)))
+
+(defun pixel-fill-find-fill-point (start)
+ "Find a place suitable for breaking the current line.
+START should be the earliest buffer position that should be considered
+(typically the start of the line), and this function will search
+backward in the current buffer from the current position."
+ (let ((bp (point))
+ (end (point))
+ failed)
+ (while (not
+ (or (setq failed (<= (point) start))
+ (eq (preceding-char) ?\s)
+ (eq (following-char) ?\s)
+ (pixel-fill--char-breakable-p (preceding-char))
+ (pixel-fill--char-breakable-p (following-char))
+ (and (pixel-fill--char-kinsoku-bol-p (preceding-char))
+ (pixel-fill--char-breakable-p (following-char))
+ (not (pixel-fill--char-kinsoku-bol-p (following-char))))
+ (pixel-fill--char-kinsoku-eol-p (following-char))
+ (bolp)))
+ (backward-char 1))
+ (if failed
+ ;; There's no breakable point, so we give it up.
+ (let (found)
+ (goto-char bp)
+ ;; Don't overflow the window edge, even if
+ ;; `pixel-fill-respect-kinsoku' is t.
+ (when pixel-fill-respect-kinsoku
+ (while (setq found (re-search-forward
+ "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
+ (line-end-position) 'move)))
+ (if (and found
+ (not (match-beginning 1)))
+ (goto-char (match-beginning 0)))))
+ (or
+ (eolp)
+ ;; Don't put kinsoku-bol characters at the beginning of a line,
+ ;; or kinsoku-eol characters at the end of a line.
+ (cond
+ ;; Don't overflow the window edge, even if `pixel-fill-respect-kinsoku'
+ ;; is t.
+ ((not pixel-fill-respect-kinsoku)
+ (while (and (not (eq (preceding-char) ?\s))
+ (or (pixel-fill--char-kinsoku-eol-p (preceding-char))
+ (pixel-fill--char-kinsoku-bol-p (following-char))))
+ (backward-char 1))
+ (when (setq failed (<= (point) start))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we look for the second best position.
+ (while (and (progn
+ (forward-char 1)
+ (<= (point) end))
+ (progn
+ (setq bp (point))
+ (pixel-fill--char-kinsoku-eol-p (following-char)))))
+ (goto-char bp)))
+ ((pixel-fill--char-kinsoku-eol-p (preceding-char))
+ ;; Find backward the point where kinsoku-eol characters begin.
+ (let ((count 4))
+ (while
+ (progn
+ (backward-char 1)
+ (and (> (setq count (1- count)) 0)
+ (not (eq (preceding-char) ?\s))
+ (or (pixel-fill--char-kinsoku-eol-p (preceding-char))
+ (pixel-fill--char-kinsoku-bol-p (following-char)))))))
+ (when (setq failed (<= (point) start))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
+ ((pixel-fill--char-kinsoku-bol-p (following-char))
+ ;; Find forward the point where kinsoku-bol characters end.
+ (let ((count 4))
+ (while (progn
+ (forward-char 1)
+ (and (>= (setq count (1- count)) 0)
+ (pixel-fill--char-kinsoku-bol-p (following-char))
+ (pixel-fill--char-breakable-p (following-char))))))))
+ (when (eq (following-char) ?\s)
+ (forward-char 1))))
+ (not failed)))
+
+(provide 'pixel-fill)
+
+;;; pixel-fill.el ends here
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 32e6618..2d1bf20 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -106,8 +106,17 @@ valid THING.
Return a cons cell (START . END) giving the start and end
positions of the thing found."
- (if (get thing 'bounds-of-thing-at-point)
- (funcall (get thing 'bounds-of-thing-at-point))
+ (cond
+ ((get thing 'bounds-of-thing-at-point)
+ (funcall (get thing 'bounds-of-thing-at-point)))
+ ;; If the buffer is totally empty, give up.
+ ((and (not (eq thing 'whitespace))
+ (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "[^\t\n ]" nil t))))
+ nil)
+ ;; Find the thing.
+ (t
(let ((orig (point)))
(ignore-errors
(save-excursion
@@ -149,7 +158,7 @@ positions of the thing found."
(lambda () (forward-thing thing -1))))
(point))))
(if (and (<= real-beg orig) (<= orig end) (< real-beg end))
- (cons real-beg end))))))))))
+ (cons real-beg end)))))))))))
;;;###autoload
(defun thing-at-point (thing &optional no-properties)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index fb06a95..a53add7 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -2968,7 +2968,8 @@ Save CHILD into the :last-deleted list, so it can be
inserted later."
"A widget which groups other widgets inside."
:convert-widget 'widget-types-convert-widget
:copy 'widget-types-copy
- :format ":\n%v"
+ :format (concat (propertize ":" 'display "")
+ "\n%v")
:value-create 'widget-group-value-create
:value-get 'widget-editable-list-value-get
:default-get 'widget-group-default-get
diff --git a/src/nsterm.h b/src/nsterm.h
index a32b8fe..ce8f594 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1352,9 +1352,7 @@ enum NSWindowTabbingMode
#define NSPasteboardTypeTabularText NSTabularTextPboardType
#define NSPasteboardTypeURL NSURLPboardType
#define NSPasteboardTypeHTML NSHTMLPboardType
-#define NSPasteboardTypeMultipleTextSelection NSMultipleTextSelectionPboardType
#define NSPasteboardTypePDF NSPDFPboardType
-#define NSPasteboardTypePNG NSPNGPboardType
#define NSPasteboardTypeRTF NSRTFPboardType
#define NSPasteboardTypeRTFD NSRTFDPboardType
#define NSPasteboardTypeTIFF NSTIFFPboardType
diff --git a/src/nsterm.m b/src/nsterm.m
index 747539e..f5c2d4d 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -3307,16 +3307,17 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
if (s->hl == DRAW_CURSOR)
[FRAME_BACKGROUND_COLOR (s->f) set];
- else if (face->underline_defaulted_p)
- [defaultCol set];
else
- [ns_lookup_indexed_color (face->underline_color, s->f) set];
+ [defaultCol set];
/* Do underline. */
if (face->underline)
{
if (s->face->underline == FACE_UNDER_WAVE)
{
+ if (!face->underline_defaulted_p)
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
+
ns_draw_underwave (s, width, x);
}
else if (s->face->underline == FACE_UNDER_LINE)
@@ -3387,6 +3388,9 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
s->underline_position = position;
r = NSMakeRect (x, s->ybase + position, width, thickness);
+
+ if (!face->underline_defaulted_p)
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
NSRectFill (r);
}
}
@@ -3396,6 +3400,10 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
{
NSRect r;
r = NSMakeRect (x, s->y, width, 1);
+
+ if (!face->overline_color_defaulted_p)
+ [ns_lookup_indexed_color (face->overline_color, s->f) set];
+
NSRectFill (r);
}
@@ -3418,6 +3426,9 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
dy = lrint ((glyph_height - h) / 2);
r = NSMakeRect (x, glyph_y + dy, width, 1);
+ if (!face->strike_through_color_defaulted_p)
+ [ns_lookup_indexed_color (face->strike_through_color, s->f) set];
+
NSRectFill (r);
}
}
@@ -4066,7 +4077,6 @@ ns_draw_glyph_string (struct glyph_string *s)
? ns_lookup_indexed_color (NS_FACE_FOREGROUND
(s->face),
s->f)
: FRAME_FOREGROUND_COLOR (s->f));
- [col set];
/* Draw underline, overline, strike-through. */
ns_draw_text_decoration (s, s->face, col, s->width, s->x);
@@ -6655,6 +6665,12 @@ not_in_argv (NSString *arg)
if (lines == 0 && x_coalesce_scroll_events)
return;
+ if (NUMBERP (Vns_scroll_event_delta_factor))
+ {
+ x *= XFLOATINT (Vns_scroll_event_delta_factor);
+ y *= XFLOATINT (Vns_scroll_event_delta_factor);
+ }
+
emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT;
emacs_event->arg = list3 (make_fixnum (lines),
make_float (x),
@@ -10027,6 +10043,12 @@ This variable is ignored on macOS < 10.7 and GNUstep.
Default is t. */);
DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line");
+ DEFVAR_LISP ("ns-scroll-event-delta-factor", Vns_scroll_event_delta_factor,
+ doc: /* A delta to apply to pixel deltas reported in scroll
events.
+ This is only effective for pixel deltas generated from touch pads or
+ mice with smooth scrolling capability. */);
+ Vns_scroll_event_delta_factor = make_float (1.0);
+
/* Tell Emacs about this window system. */
Fprovide (Qns, Qnil);
diff --git a/src/xterm.c b/src/xterm.c
index a6d9c8c..ed6a311 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10045,8 +10045,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0);
- if (FLOATP (Vx_scroll_event_delta_factor))
- scroll_unit *= XFLOAT_DATA
(Vx_scroll_event_delta_factor);
+ if (NUMBERP (Vx_scroll_event_delta_factor))
+ scroll_unit *= XFLOATINT
(Vx_scroll_event_delta_factor);
if (val->horizontal)
{
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index 4b97f5f..b0ea681 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -93,8 +93,8 @@ default:
# Prepare test artifacts.
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp
${test_name}:checkout/test ${test_name}
- test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}
- - /usr/bin/find ${test_name} ! -name "*.log" -type f -delete
- - /usr/bin/find ${test_name} -empty -type d -delete
+ - find ${test_name} ! -name "*.log" -type f -delete
+ - find ${test_name} -type d -depth -exec rmdir {} + 2>/dev/null
.build-template:
needs: []