[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp a26b147 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp a26b147 1/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Thu, 10 Sep 2020 05:00:43 -0400 (EDT) |
branch: feature/native-comp
commit a26b14733bba6659548f00db634bc45ccd222447
Merge: 107514a 931b9f5
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
doc/emacs/trouble.texi | 20 +-
doc/lispref/debugging.texi | 2 +-
doc/lispref/display.texi | 3 +
doc/lispref/intro.texi | 4 +-
doc/lispref/minibuf.texi | 2 +
doc/lispref/streams.texi | 2 +-
doc/misc/dbus.texi | 35 +--
doc/misc/gnus.texi | 224 ++++++++++---------
doc/misc/tramp.texi | 6 +
etc/NEWS | 57 ++++-
lisp/abbrev.el | 7 +-
lisp/bookmark.el | 8 +-
lisp/button.el | 4 +
lisp/calc/calc-bin.el | 4 +-
lisp/calc/calc-store.el | 10 +-
lisp/calc/calcalg3.el | 24 +-
lisp/calendar/calendar.el | 2 +-
lisp/calendar/holidays.el | 2 +-
lisp/calendar/timeclock.el | 6 +-
lisp/calendar/todo-mode.el | 18 +-
lisp/cedet/semantic/symref/list.el | 10 +-
lisp/char-fold.el | 7 +
lisp/cmuscheme.el | 5 +-
lisp/completion.el | 6 +-
lisp/cus-dep.el | 34 ++-
lisp/cus-edit.el | 20 +-
lisp/dired-aux.el | 6 +-
lisp/dired-x.el | 16 +-
lisp/dired.el | 5 +-
lisp/display-fill-column-indicator.el | 13 +-
lisp/dnd.el | 23 +-
lisp/emacs-lisp/advice.el | 14 +-
lisp/emacs-lisp/checkdoc.el | 3 +-
lisp/emacs-lisp/debug.el | 7 +-
lisp/emacs-lisp/disass.el | 5 +-
lisp/emacs-lisp/easy-mmode.el | 11 +-
lisp/emacs-lisp/elp.el | 6 +-
lisp/emacs-lisp/ert.el | 8 +-
lisp/emacs-lisp/find-func.el | 10 +-
lisp/emacs-lisp/gv.el | 11 +
lisp/emacs-lisp/package.el | 5 +-
lisp/emacs-lisp/re-builder.el | 2 +-
lisp/emacs-lisp/smie.el | 7 +-
lisp/emacs-lisp/trace.el | 17 +-
lisp/emacs-lisp/warnings.el | 19 +-
lisp/emacs-lock.el | 11 +-
lisp/emulation/cua-rect.el | 4 +-
lisp/emulation/edt-mapper.el | 3 +-
lisp/erc/erc-dcc.el | 4 +-
lisp/erc/erc-status-sidebar.el | 308 +++++++++++++++++++++++++
lisp/erc/erc.el | 3 +-
lisp/eshell/esh-mode.el | 1 +
lisp/facemenu.el | 2 +-
lisp/faces.el | 5 +-
lisp/ffap.el | 2 +-
lisp/files-x.el | 19 +-
lisp/files.el | 32 +--
lisp/find-dired.el | 16 +-
lisp/format.el | 8 +-
lisp/frame.el | 17 +-
lisp/gnus/gnus-bookmark.el | 3 +-
lisp/gnus/gnus-cache.el | 28 ++-
lisp/gnus/gnus-cloud.el | 3 +-
lisp/gnus/gnus-group.el | 35 +--
lisp/gnus/gnus-score.el | 19 +-
lisp/gnus/gnus-srvr.el | 1 -
lisp/gnus/gnus-start.el | 4 +-
lisp/gnus/gnus-sum.el | 53 +++--
lisp/gnus/gnus.el | 2 +-
lisp/gnus/mm-decode.el | 23 +-
lisp/gnus/mm-view.el | 12 +-
lisp/gnus/nnheader.el | 29 ++-
lisp/gnus/nnir.el | 26 ++-
lisp/gnus/nnselect.el | 20 +-
lisp/help-fns.el | 23 +-
lisp/help.el | 15 +-
lisp/hi-lock.el | 8 +-
lisp/ibuf-ext.el | 26 +--
lisp/icomplete.el | 101 ++++++---
lisp/imenu.el | 11 +-
lisp/indent.el | 11 +-
lisp/info-look.el | 11 +-
lisp/info.el | 23 +-
lisp/international/mule-cmds.el | 14 +-
lisp/international/mule.el | 17 +-
lisp/international/ogonek.el | 8 +-
lisp/isearch.el | 2 +-
lisp/locate.el | 4 +-
lisp/mail/emacsbug.el | 91 ++++++--
lisp/mail/mailabbrev.el | 5 +-
lisp/mail/mailalias.el | 6 +-
lisp/mail/rmail.el | 41 ++--
lisp/mail/rmailmm.el | 2 +-
lisp/mail/sendmail.el | 2 +-
lisp/man.el | 11 +-
lisp/minibuffer.el | 18 +-
lisp/misearch.el | 7 +-
lisp/mpc.el | 4 +-
lisp/net/browse-url.el | 2 +-
lisp/net/dbus.el | 269 +++++++++++++---------
lisp/net/eww.el | 127 +++++++----
lisp/net/rcirc.el | 2 +-
lisp/net/tramp.el | 5 +
lisp/org/ol-gnus.el | 6 +-
lisp/play/handwrite.el | 2 +-
lisp/printing.el | 30 ++-
lisp/profiler.el | 2 +-
lisp/progmodes/cc-engine.el | 53 +++--
lisp/progmodes/cc-langs.el | 14 ++
lisp/progmodes/compile.el | 7 +-
lisp/progmodes/cperl-mode.el | 8 +-
lisp/progmodes/etags.el | 4 +-
lisp/progmodes/inf-lisp.el | 5 +-
lisp/progmodes/octave.el | 14 +-
lisp/progmodes/prolog.el | 8 +-
lisp/progmodes/python.el | 4 +-
lisp/progmodes/sh-script.el | 3 +-
lisp/progmodes/tcl.el | 5 +-
lisp/rect.el | 9 +-
lisp/replace.el | 15 +-
lisp/server.el | 3 +-
lisp/ses.el | 14 +-
lisp/simple.el | 12 +-
lisp/speedbar.el | 5 +-
lisp/subr.el | 1 +
lisp/tab-bar.el | 3 +-
lisp/tab-line.el | 47 ++--
lisp/term.el | 8 +-
lisp/textmodes/css-mode.el | 23 +-
lisp/textmodes/flyspell.el | 8 +-
lisp/textmodes/ispell.el | 13 +-
lisp/textmodes/refer.el | 6 +-
lisp/textmodes/reftex-ref.el | 4 +-
lisp/textmodes/rst.el | 18 +-
lisp/textmodes/sgml-mode.el | 6 +-
lisp/textmodes/table.el | 31 ++-
lisp/vc/add-log.el | 2 +-
lisp/vc/diff-mode.el | 7 +-
lisp/vc/ediff-mult.el | 8 +-
lisp/vc/ediff-ptch.el | 12 +-
lisp/vc/ediff-util.el | 29 ++-
lisp/vc/ediff.el | 101 ++++-----
lisp/vc/emerge.el | 5 +-
lisp/vc/log-edit.el | 8 +-
lisp/vc/vc-annotate.el | 4 +-
lisp/vc/vc.el | 25 +--
lisp/w32-fns.el | 3 +-
lisp/wid-edit.el | 9 +-
lisp/woman.el | 13 +-
lisp/xwidget.el | 17 +-
src/dbusbind.c | 20 +-
src/image.c | 24 +-
src/nsmenu.m | 6 -
test/file-organization.org | 4 +-
test/lisp/custom-tests.el | 4 +-
test/lisp/emacs-lisp/gv-tests.el | 40 ++++
test/lisp/emacs-lisp/package-tests.el | 4 +-
test/lisp/mwheel-tests.el | 4 +-
test/lisp/net/dbus-tests.el | 385 ++++++++++++++++++++++++++++++--
test/lisp/progmodes/cperl-mode-tests.el | 11 +-
160 files changed, 2224 insertions(+), 1181 deletions(-)
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 33f67f2..dbd1a07 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -721,18 +721,24 @@ will be sent to the Emacs maintainers at
@ifhtml
@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}.
@end ifhtml
-(If you want to suggest an improvement or new feature, use the same
-address.) If you cannot send mail from inside Emacs, you can copy the
+If you cannot send mail from inside Emacs, you can copy the
text of your report to your normal mail client (if your system
supports it, you can type @kbd{C-c M-i} to have Emacs do this for you)
and send it to that address. Or you can simply send an email to that
address describing the problem.
-Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
-stored in the GNU Bug Tracker at @url{https://debbugs.gnu.org}. Please
-include a valid reply email address, in case we need to ask you for
-more information about your report. Submissions are moderated, so
-there may be a delay before your report appears.
+If you want to submit code to Emacs (to fix a problem or implement a
+new feature), the easiest way to do this is to send a patch to the
+Emacs issue tracker. This is done with the @kbd{M-x
+submit-emacs-patch} command, and works much the same as when reporting
+bugs.
+
+In any case, your report will be sent to the @samp{bug-gnu-emacs}
+mailing list, and stored in the GNU Bug Tracker at
+@url{https://debbugs.gnu.org}. Please include a valid reply email
+address, in case we need to ask you for more information about your
+report. Submissions are moderated, so there may be a delay before
+your report appears.
You do not need to know how the GNU Bug Tracker works in order to
report a bug, but if you want to, you can read the tracker's online
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 29a0ab7..3fea604 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -147,7 +147,7 @@ set @code{debug-ignored-errors} to @code{nil}.
If this variable has a non-@code{nil} value (the default), running the
command @code{eval-expression} causes @code{debug-on-error} to be
temporarily bound to @code{t}. @xref{Lisp Eval,, Evaluating
-Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}.
+Emacs Lisp Expressions, emacs, The GNU Emacs Manual}.
If @code{eval-expression-debug-on-error} is @code{nil}, then the value
of @code{debug-on-error} is not changed during @code{eval-expression}.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index d3adb62..e549400 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6926,6 +6926,9 @@ such as @code{forward-button} and @code{backward-button}
are
additionally available in the keymap stored in
@code{button-buffer-map}; a mode which uses buttons may want to use
@code{button-buffer-map} as a parent keymap for its keymap.
+Alternatively, the @code{button-mode} can be switched on for much the
+same effect: It's a minor mode that does nothing else than install
+@code{button-buffer-map} as a minor mode keymap.
If the button has a non-@code{nil} @code{follow-link} property, and
@code{mouse-1-click-follows-link} is set, a quick @key{mouse-1} click
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 8e4fbc7..254d4e9 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -87,7 +87,9 @@ you are criticizing.
@cindex bugs
@cindex suggestions
-Please send comments and corrections using @kbd{M-x report-emacs-bug}.
+Please send comments and corrections using @kbd{M-x
+report-emacs-bug}. If you wish to contribute new code (or send a
+patch to fix a problem), use @kbd{M-x submit-emacs-patch}).
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index cca06c7..d30114f 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -440,6 +440,8 @@ case no default values are displayed.
If @var{default} is @code{nil}, there is no default value, and
therefore no ``default value'' string is included in the result value.
+If @var{default} is a non-@code{nil} list, the first element of the
+list is used in the prompt.
@end defun
@node Object from Minibuffer
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index d40ec8d..2cd61ad 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -859,7 +859,7 @@ exceeding this limit is abbreviated with an ellipsis. A
value of
These are the values for @code{print-length} and @code{print-level}
used by @code{eval-expression}, and thus, indirectly, by many
interactive evaluation commands (@pxref{Lisp Eval,, Evaluating
-Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}).
+Emacs Lisp Expressions, emacs, The GNU Emacs Manual}).
@end defopt
These variables are used for detecting and reporting circular
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index c16b7aa..2880b7f 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -59,7 +59,7 @@ another. An overview of D-Bus can be found at
* Type Conversion:: Mapping Lisp types and D-Bus types.
* Synchronous Methods:: Calling methods in a blocking way.
* Asynchronous Methods:: Calling methods non-blocking.
-* Receiving Method Calls:: Offering own methods.
+* Register Objects:: Offering own services.
* Signals:: Sending and receiving signals.
* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
@@ -744,16 +744,17 @@ result can be any valid D-Bus value, or @code{nil} if
there is no
@end lisp
@end defun
-@defun dbus-set-property bus service path interface property value
+@defun dbus-set-property bus service path interface property [type] value
This function sets the value of @var{property} of @var{interface} to
@var{value}. It will be checked at @var{bus}, @var{service},
-@var{path}. When the value is successfully set, this function returns
-@var{value}. Otherwise, it returns @code{nil}. Example:
+@var{path}. @var{value} can be preceded by a @var{type} symbol. When
+the value is successfully set, this function returns @var{value}.
+Otherwise, it returns @code{nil}. Example:
@lisp
(dbus-set-property
:session "org.kde.kaccess" "/MainApplication"
- "com.trolltech.Qt.QApplication" "doubleClickInterval" 500)
+ "com.trolltech.Qt.QApplication" "doubleClickInterval" :uint16 500)
@result{} 500
@end lisp
@@ -1340,11 +1341,15 @@ message arrives, and @var{handler} is called. Example:
@end defun
-@node Receiving Method Calls
-@chapter Offering own methods.
+@node Register Objects
+@chapter Offering own services.
@cindex method calls, returning
@cindex returning method calls
+You can offer an own service in D-Bus, which will be visible by other
+D-Bus clients. See
@uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
+for a discussion of the design.
+
In order to register methods on the D-Bus, Emacs has to request a well
known name on the D-Bus under which it will be available for other
clients. Names on the D-Bus can be registered and unregistered using
@@ -1466,9 +1471,9 @@ If @var{handler} returns a reply message with an empty
argument list,
to distinguish it from @code{nil} (the boolean false).
If @var{handler} detects an error, it shall return the list
-@code{(:error @var{ERROR-NAME} @var{ERROR-MESSAGE)}}.
-@var{ERROR-NAME} is a namespaced string which characterizes the error
-type, and @var{ERROR-MESSAGE} is a free text string. Alternatively,
+@code{(:error @var{error-name} @var{error-message)}}.
+@var{error-name} is a namespaced string which characterizes the error
+type, and @var{error-message} is a free text string. Alternatively,
any Emacs signal @code{dbus-error} in @var{handler} raises a D-Bus
error message with the error name @samp{org.freedesktop.DBus.Error.Failed}.
@@ -1561,7 +1566,7 @@ The test then runs
@end example
@end defun
-@defun dbus-register-property bus service path interface property access value
&optional emits-signal dont-register-service
+@defun dbus-register-property bus service path interface property access
[type] value &optional emits-signal dont-register-service
With this function, an application declares a @var{property} on the D-Bus
@var{bus}.
@@ -1579,9 +1584,11 @@ discussion of @var{dont-register-service} below).
@var{access} indicates, whether the property can be changed by other
services via D-Bus. It must be either the symbol @code{:read},
-@code{:write} or @code{:readwrite}. @var{value} is the initial value
-of the property, it can be of any valid type (@xref{dbus-call-method},
-for details).
+@code{:write} or @code{:readwrite}.
+
+@var{value} is the initial value of the property, it can be of any
+valid type (@xref{dbus-call-method}, for details). @var{value} can be
+preceded by a @var{type} symbol.
If @var{property} already exists on @var{path}, it will be
overwritten. For properties with access type @code{:read} this is the
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index de5e8f3..4a09eac 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -842,7 +842,6 @@ Formatting Variables
* Formatting Fonts:: Making the formatting look colorful and nice.
* Positioning Point:: Moving point to a position after an operation.
* Tabulation:: Tabulating your output.
-* Wide Characters:: Dealing with wide characters.
Image Enhancements
@@ -10417,12 +10416,12 @@ article (@code{gnus-summary-refer-references}).
@findex gnus-summary-refer-thread
@kindex A T @r{(Summary)}
Display the full thread where the current article appears
-(@code{gnus-summary-refer-thread}). By default this command looks for
-articles only in the current group. Some backends (currently only
-'nnimap) know how to find articles in the thread directly. In other
-cases each header in the current group must be fetched and examined,
-so it usually takes a while. If you do it often, you may consider
-setting @code{gnus-fetch-old-headers} to @code{invisible}
+(@code{gnus-summary-refer-thread}). By default this command looks for
+articles only in the current group. Some backends (currently only
+@code{nnimap}) know how to find articles in the thread directly. In
+other cases each header in the current group must be fetched and
+examined, so it usually takes a while. If you do it often, you may
+consider setting @code{gnus-fetch-old-headers} to @code{invisible}
(@pxref{Filling In Threads}). This won't have any visible effects
normally, but it'll make this command work a whole lot faster. Of
course, it'll make group entry somewhat slow.
@@ -10441,12 +10440,13 @@ by giving the @kbd{A T} command a numerical prefix.
@vindex gnus-refer-thread-limit-to-thread
In most cases @code{gnus-refer-thread} adds any articles it finds to
-the current summary buffer. (When @code{gnus-refer-thread-use-search}
+the current summary buffer. (When @code{gnus-refer-thread-use-search}
is true and the initial referral starts from a summary buffer for a
-non-virtual group this may not be possible. In this case a new summary
-buffer is created holding a virtual group with the result of the thread
-search). If @code{gnus-refer-thread-limit-to-thread} is non-nil then
-the summary buffer will be limited to articles in the thread.
+non-virtual group this may not be possible. In this case a new
+summary buffer is created holding a virtual group with the result of
+the thread search.) If @code{gnus-refer-thread-limit-to-thread} is
+non-nil then the summary buffer will be limited to articles in the
+thread.
@item M-^ (Summary)
@findex gnus-summary-refer-article
@@ -17869,7 +17869,7 @@ whole groups together into virtual groups.
@menu
* Selection Groups:: Combining articles from many groups.
-* Combined Groups:: Combining multiple groups.
+* Combined Groups:: Combining multiple groups.
@end menu
@@ -17882,36 +17882,35 @@ whole groups together into virtual groups.
Gnus provides the @dfn{nnselect} method for creating virtual groups
composed of collections of messages, even when these messages come
-from groups that span multiple servers and backends. For the most part
-these virtual groups behave like any other group: messages may be
+from groups that span multiple servers and backends. For the most
+part these virtual groups behave like any other group: messages may be
threaded, marked, moved, deleted, copied, etc.; groups may be
ephemeral or persistent; groups may be created via
@code{gnus-group-make-group} or browsed as foreign via
@code{gnus-group-browse-foreign-server}.
The key to using an nnselect group is specifying the messages to
-include. Each nnselect group has a group parameter
+include. Each nnselect group has a group parameter
@code{nnselect-specs} which is an alist with two elements: a function
@code{nnselect-function}; and arguments @code{nnselect-args} to be
passed to the function, if any.
-The function @code{nnselect-function} must return a vector. Each
+The function @code{nnselect-function} must return a vector. Each
element of this vector is in turn a 3-element vector corresponding to
-one message. The 3 elements are: the fully-qualified group name; the
-message number; and a "score" that can be used for additional
-sorting. The values for the score are arbitrary, and are not used
-directly by the nnselect method---they may, for example, all be set to
-100.
+one message. The 3 elements are: the fully-qualified group name; the
+message number; and a "score" that can be used for additional sorting.
+The values for the score are arbitrary, and are not used directly by
+the nnselect method---they may, for example, all be set to 100.
Here is an example:
@lisp
- (nnselect-specs
- (nnselect-function . identity)
- (nnselect-args .
- [["nnimap+work:mail" 595 100]
- ["nnimap+home:sent" 223 100]
- ["nntp+news.gmane.org:gmane.emacs.gnus.general" 23666 100]]))
+(nnselect-specs
+ (nnselect-function . identity)
+ (nnselect-args
+ . [["nnimap+work:mail" 595 100]
+ ["nnimap+home:sent" 223 100]
+ ["nntp+news.gmane.org:gmane.emacs.gnus.general" 23666 100]]))
@end lisp
The function is the identity and the argument is just the list of
@@ -17920,21 +17919,21 @@ messages to include in the virtual group.
Or we may wish to create a group from the results of a search query:
@lisp
- (nnselect-specs
- (nnselect-function . nnir-run-query)
- (nnselect-args
- (nnir-query-spec
- (query . "FLAGGED")
- (criteria . ""))
- (nnir-group-spec
- ("nnimap:home")
- ("nnimap:work"))))
+(nnselect-specs
+ (nnselect-function . nnir-run-query)
+ (nnselect-args
+ (nnir-query-spec
+ (query . "FLAGGED")
+ (criteria . ""))
+ (nnir-group-spec
+ ("nnimap:home")
+ ("nnimap:work"))))
@end lisp
This creates a group including all flagged messages from all groups on
-two imap servers, "home" and "work".
+two IMAP servers, "home" and "work".
-And one last example. Here is a function that runs a search query to
+And one last example. Here is a function that runs a search query to
find all message that have been received recently from certain groups:
@lisp
@@ -17946,45 +17945,44 @@ find all message that have been received recently
from certain groups:
(time-subtract (current-time)
(days-to-time (car args)))))
(cons 'criteria "")))
- (group-spec (cadr args)))
- (nnir-run-query (cons 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))))
+ (group-spec (cadr args)))
+ (nnir-run-query (cons 'nnir-specs
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))))
@end lisp
-Then an nnselect-specs
+Then the following @code{nnselect-specs}:
@lisp
- (nnselect-specs
- (nnselect-function . my-recent-email)
- (nnselect-args . (7 (("nnimap:home") ("nnimap:work")))))
+(nnselect-specs
+ (nnselect-function . my-recent-email)
+ (nnselect-args . (7 (("nnimap:home") ("nnimap:work")))))
@end lisp
will provide a group composed of all messages on the home and work
servers received in the last 7 days.
Refreshing the selection of an nnselect group by running the
-@code{nnselect-function} may take a long time to
-complete. Consequently nnselect groups are not refreshed by default
-when @code{gnus-group-get-new-news} is invoked. In those cases where
-running the function is not too time-consuming, a non-nil group
-parameter of @code{nnselect-rescan} will allow automatic refreshing. A
-refresh can always be invoked manually through
+@code{nnselect-function} may take a long time to complete.
+Consequently nnselect groups are not refreshed by default when
+@code{gnus-group-get-new-news} is invoked. In those cases where
+running the function is not too time-consuming, a non-@code{nil} group
+parameter of @code{nnselect-rescan} will allow automatic refreshing.
+A refresh can always be invoked manually through
@code{gnus-group-get-new-news-this-group}.
The nnir interface (@pxref{nnir}) includes engines for searching a
-variety of backends. While the details of each search engine vary, the
-result of an nnir search is always a vector of the sort used by the
-nnselect method, and the results of nnir queries are usually viewed
-using an nnselect group. Indeed the standard search function
+variety of backends. While the details of each search engine vary,
+the result of an nnir search is always a vector of the sort used by
+the nnselect method, and the results of nnir queries are usually
+viewed using an nnselect group. Indeed the standard search function
@code{gnus-group-read-ephemeral-search-group} just creates an
ephemeral nnselect group with the appropriate nnir query as the
@code{nnselect-specs}. nnir originally included both the search
-engines and the glue to connect search results to gnus. Over time this
-glue evolved into the nnselect method. The two had
-a mostly amicable parting so that nnselect could pursue its dream of
-becoming a fully functioning backend, but occasional conflicts may
-still linger.
+engines and the glue to connect search results to gnus. Over time
+this glue evolved into the nnselect method. The two had a mostly
+amicable parting so that nnselect could pursue its dream of becoming a
+fully functioning backend, but occasional conflicts may still linger.
@node Combined Groups
@subsection Combined Groups
@@ -20348,6 +20346,24 @@ this will match articles that were posted when it was
April 1st where
the article was posted from. Time zones are such wholesome fun for the
whole family, eh?)
+Finally, two actually useful match types for dates: @code{<} and
+@code{>}. These will allow scoring on the relative age (in days) of
+the articles. Here's an example score file using the method:
+
+@example
+(("date"
+ (7 10 nil <)
+ (7 -10 nil >)
+ (14 -10 nil >)))
+@end example
+
+This results in articles less than a week old getting a 10 point
+increase, articles older than a week getting a 10 point decrease, and
+articles older than two weeks getting a cumulative 20 point decrease.
+
+The day can also be a floating point number: To score articles less
+than an hour old, you can say @samp{(0.04 10 nil <)}.
+
@item Head, Body, All
These three match keys use the same match types as the @code{From} (etc.)@:
header uses.
@@ -21383,22 +21399,21 @@ FIXME: A brief comparison of nnir, nnmairix,
contrib/gnus-namazu would
be nice.
Gnus has various ways of finding articles that match certain criteria
-(from a particular author, on a certain subject, etc). The simplest
+(from a particular author, on a certain subject, etc.). The simplest
method is to enter a group and then either "limit" the summary buffer
to the desired articles using the limiting commands (@xref{Limiting}),
or searching through messages in the summary buffer (@xref{Searching
for Articles}).
Limiting commands and summary buffer searching work on subsets of the
-articles already fetched from the servers, and these commands won’t
+articles already fetched from the servers, and these commands won't
query the server for additional articles. While simple, these methods
are therefore inadequate if the desired articles span multiple groups,
-or if the group is so large that fetching all articles is
-impractical. Many backends (such as imap, notmuch, namazu, etc.)
-provide their own facilities to search for articles directly on the
-server and gnus can take advantage of these methods. This chapter
-describes tools for searching groups and servers for articles matching
-a query.
+or if the group is so large that fetching all articles is impractical.
+Many backends (such as imap, notmuch, namazu, etc.) provide their own
+facilities to search for articles directly on the server and Gnus can
+take advantage of these methods. This chapter describes tools for
+searching groups and servers for articles matching a query.
@menu
* nnir:: Searching with various engines.
@@ -21436,19 +21451,29 @@ maintained outside of Gnus.
@subsection Basic Usage
In the group buffer typing @kbd{G G} will search the group on the
-current line by calling @code{gnus-group-make-search-group}. This prompts
-for a query string, creates an ephemeral @code{nnselect} group containing
-the articles that match this query, and takes you to a summary buffer
-showing these articles. Articles may then be read, moved and deleted
-using the usual commands.
-
-The @code{nnselect} group made in this way is an @code{ephemeral}
-group, and will disappear upon exit from the group. However changes
-made in the group are permanently reflected in the real groups from
-which the articles are drawn. It is occasionally convenient to view
-articles found through searching in their original group. You can
-@emph{warp} (i.e., jump) to the original group for the article on the
-current line with @kbd{A W}, aka @code{gnus-warp-to-article}.
+current line by calling @code{gnus-group-read-ephemeral-search-group}.
+This prompts for a query string, creates an ephemeral @code{nnselect}
+group containing the articles that match this query, and takes you to
+a summary buffer showing these articles. Articles may then be read,
+moved and deleted using the usual commands.
+
+The @code{nnselect} group made in this way is @code{ephemeral}: it
+will disappear upon exit from the group. However changes made in the
+group are permanently reflected in the real groups from which the
+articles are drawn. If you want to create a @emph{persistent} group
+that sticks around after exit from the summary buffer, you can call
+@code{gnus-group-make-search-group} (bound to @kbd{G g}).
+
+So you just performed a search whose results are so fabulous you
+wished you had done a persistent search rather than an ephemeral one?
+No problem; you can create such a group by calling
+@code{gnus-summary-make-group-from-search} (bound to @kbd{C-c C-p})
+from the ephemeral summary buffer.
+
+It is occasionally convenient to view articles found through searching
+in their original group. You can @emph{warp} (i.e., jump) to the
+original group for the article on the current line with @kbd{A W}, aka
+@code{gnus-warp-to-article}.
You say you want to search more than just the group on the current line?
No problem: just process-mark the groups you want to search. You want
@@ -21456,16 +21481,17 @@ even more? Calling for an nnir search with the
cursor on a topic heading
will search all the groups under that heading.
Still not enough? OK, in the server buffer
-@code{gnus-group-make-search-group} (now bound to @kbd{G}) will search
-all groups from the server on the current line. Too much? Want to
-ignore certain groups when searching, like spam groups? Just
+@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+will search all groups from the server on the current line. Too much?
+Want to ignore certain groups when searching, like spam groups? Just
customize @code{nnir-ignored-newsgroups}.
One more thing: individual search engines may have special search
-features. You can access these special features by giving a prefix-arg
-to @code{gnus-group-make-search-group}. If you are searching multiple
-groups with different search engines you will be prompted for the
-special search features for each engine separately.
+features. You can access these special features by giving a
+prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
+are searching multiple groups with different search engines you will
+be prompted for the special search features for each engine
+separately.
@node Setting up nnir
@@ -22608,7 +22634,6 @@ lots of percentages everywhere.
* Formatting Fonts:: Making the formatting look colorful and nice.
* Positioning Point:: Moving point to a position after an operation.
* Tabulation:: Tabulating your output.
-* Wide Characters:: Dealing with wide characters.
@end menu
Currently Gnus uses the following formatting variables:
@@ -22863,23 +22888,6 @@ This is the soft tabulator.
50 will be removed. This is the hard tabulator.
-@node Wide Characters
-@subsection Wide Characters
-
-Fixed width fonts in most countries have characters of the same width.
-Some countries, however, use Latin characters mixed with wider
-characters---most notable East Asian countries.
-
-The problem is that when formatting, Gnus assumes that if a string is 10
-characters wide, it'll be 10 Latin characters wide on the screen. In
-these countries, that's not true.
-
-@vindex gnus-use-correct-string-widths
-To help fix this, you can set @code{gnus-use-correct-string-widths} to
-@code{t}. This makes buffer generation slower, but the results will be
-prettier. The default value is @code{nil}.
-
-
@node Window Layout
@section Window Layout
@cindex window layout
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index bdf3b40..538f85f 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2280,6 +2280,12 @@ example below:
@end group
@end lisp
+@vindex password-word-equivalents
+This variable is, by default, initialised from
+@code{password-word-equivalents} when @value{tramp} is loaded, and it
+is usually more convenient to add new passphrases to that variable
+instead of altering this variable.
+
Similar localization may be necessary for handling wrong password
prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}.
diff --git a/etc/NEWS b/etc/NEWS
index 749b28a..9d26620 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -206,6 +206,11 @@ of the next command to be displayed in a new tab.
Show/hide the tab bar independently for each frame, according to the
value of 'tab-bar-show'.
+---
+*** The tabs in the tab line can now be scrolled using horizontal scroll.
+If your mouse or trackpad supports it, you can now scroll tabs when
+the mouse pointer is in the tab line by scrolling left or right.
+
** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
'previous-error-no-select' bound to 'p'.
@@ -317,19 +322,30 @@ tags to be considered as well.
** Gnus
+++
+*** New scoring types for the Date header.
+You can now score based on the relative age of an article with the new
+'<' and '>' date scoring types.
+
++++
*** New backend 'nnselect'.
The newly added 'nnselect' backend allows creating groups from an
arbitrary list of articles that may come from multiple groups and
servers. These groups generally behave like any other group: they may
be ephemeral or persistent, and allow article marking, moving,
deletion, etc. 'nnselect' groups may be created like any other group,
-but there is also a convenience function for the common case of
+but there are three convenience functions for the common case of
obtaining the list of articles as a result of a search:
'gnus-group-make-search-group' ('G g') that will prompt for an 'nnir'
-search query and create a dedicated group for that search. As part of
-this addition, the user option 'nnir-summary-line-format' has been
-removed; it's functionality is now available directly in the
-'gnus-summary-line-format' '%G' and '%g' specs. The user option
+search query and create a persistent group for that search;
+'gnus-group-read-ephemeral-search-group' ('G G') that will prompt for
+an 'nnir' search query and create an ephemeral group for that search;
+and 'gnus-summary-make-group-from-search' ('C-c C-p') that will create
+a persistent group with the search parameters of a current ephemeral
+search group.
+
+As part of this addition, the user option 'nnir-summary-line-format'
+has been removed; its functionality is now available directly in the
+'gnus-summary-line-format' specs '%G' and '%g'. The user option
'gnus-refer-thread-use-nnir' has been renamed to
'gnus-refer-thread-use-search'.
@@ -864,6 +880,10 @@ The 'erc-current-nick-highlight-type',
'erc-pal-highlight-type',
'erc-dangerous-host-highlight-type' variables now support a 'message'
type for highlighting the entire message but not the sender's nick.
+*** erc-status-sidebar.el is now part of ERC.
+The 'erc-status-sidebar' package which provides a HexChat-like
+activity overview sidebar for joined IRC channels is now part of ERC.
+
** Battery
---
@@ -939,6 +959,24 @@ window after starting). This variable defaults to nil.
** Miscellaneous
+++
+*** New command 'submit-emacs-patch'
+This works along the lines of 'report-emacs-bug', but is more geared
+towards sending a patch to the Emacs issue tracker.
+
++++
+*** New minor mode 'button-mode'.
+This minor mode does nothing else than install 'button-buffer-map' as
+a minor mode map (which binds the TAB/S-TAB key bindings to navigate
+to buttons), and can be used in any view-mode-like buffer that has
+buttons in it.
+
+---
+*** 'icomplete-show-matches-on-no-input' behavior change.
+Previously, choosing a different completion with commands like 'C-.'
+and then hitting 'RET' would choose the default completion. Doing
+this will now choose the completion under point.
+
++++
*** The user can now customize how "default" values are prompted for.
The new utility function 'format-prompt' has been added which uses the
new 'minibuffer-default-prompt-format' user option to format "default"
@@ -1064,11 +1102,20 @@ The old names are now obsolete.
** D-Bus
+++
+*** Property values can be typed explicitly.
+'dbus-register-property' and 'dbus-set-property' accept now optional
+type symbols.
+
++++
*** Registered properties can have the new access type ':write'.
+++
*** In case of problems, handlers can emit proper D-Bus error messages now.
+---
+*** D-Bus errors, which have been converted from incoming D-Bus error
+messages, contain the error name of that message now.
+
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 468b0d9..50d0011 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -209,8 +209,7 @@ it defaults to the value of `abbrev-file-name'.
Optional second argument QUIETLY non-nil means don't display a message."
(interactive
(list
- (read-file-name (format "Read abbrev file (default %s): "
- abbrev-file-name)
+ (read-file-name (format-prompt "Read abbrev file" abbrev-file-name)
nil abbrev-file-name t)))
(load (or file abbrev-file-name) nil quietly)
(setq abbrevs-changed nil))
@@ -234,7 +233,7 @@ If VERBOSE is non-nil, display a message indicating where
abbrevs
have been saved."
(interactive
(list
- (read-file-name "Write abbrev file: "
+ (read-file-name (format-prompt "Write abbrev file" abbrev-file-name)
(file-name-directory (expand-file-name abbrev-file-name))
abbrev-file-name)))
(or (and file (> (length file) 0))
@@ -263,7 +262,7 @@ have been saved."
(defun abbrev-edit-save-to-file (file)
"Save all user-level abbrev definitions in current buffer to FILE."
(interactive
- (list (read-file-name "Save abbrevs to file: "
+ (list (read-file-name (format-prompt "Save abbrevs to file"
abbrev-file-name)
(file-name-directory
(expand-file-name abbrev-file-name))
abbrev-file-name)))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 8a3bcf8..206c872 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -803,7 +803,7 @@ still there, in order, if the topmost one is ever deleted."
(let ((str
(or name
(read-from-minibuffer
- (format "%s (default %s): " prompt default)
+ (format-prompt prompt default)
nil
bookmark-minibuffer-read-name-map
nil nil defaults))))
@@ -1425,8 +1425,8 @@ for a file, defaulting to the file defined by variable
bookmark-default-file)))
(if parg
;; This should be part of the `interactive' spec.
- (read-file-name (format "File to save bookmarks in: (%s) "
- default)
+ (read-file-name (format-prompt "File to save bookmarks in"
+ default)
(file-name-directory default) default)
default))))
(bookmark-write-file file)
@@ -1538,7 +1538,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(or (car bookmark-bookmarks-timestamp)
(expand-file-name bookmark-default-file))))
(prefix current-prefix-arg))
- (list (read-file-name (format "Load bookmarks from: (%s) " default)
+ (list (read-file-name (format-prompt "Load bookmarks from" default)
(file-name-directory default) default 'confirm)
prefix nil prefix)))
(let* ((file (expand-file-name file))
diff --git a/lisp/button.el b/lisp/button.el
index 03ab59b..1131760 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -78,6 +78,10 @@
"Keymap useful for buffers containing buttons.
Mode-specific keymaps may want to use this as their parent keymap.")
+(define-minor-mode button-mode
+ "A minor mode for navigating to buttons with the TAB key."
+ :keymap button-buffer-map)
+
;; Default properties for buttons.
(put 'default-button 'face 'button)
(put 'default-button 'mouse-face 'highlight)
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index e9083b8..33fd1af 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -126,8 +126,8 @@
(defun calc-word-size (n)
(interactive "P")
(calc-wrapper
- (or n (setq n (read-string (format "Binary word size: (default %d) "
- calc-word-size))))
+ (or n (setq n (read-string (format-prompt "Binary word size"
+ calc-word-size))))
(setq n (if (stringp n)
(if (equal n "")
calc-word-size
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 5282b83..79e6cf5 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -428,11 +428,11 @@
(defun calc-edit-variable (&optional var)
(interactive)
(calc-wrapper
- (or var (setq var (calc-read-var-name
- (if calc-last-edited-variable
- (format "Edit (default %s): "
- (calc-var-name calc-last-edited-variable))
- "Edit: "))))
+ (unless var
+ (setq var (calc-read-var-name
+ (format-prompt "Edit" (and calc-last-edited-variable
+ (calc-var-name
+ calc-last-edited-variable))))))
(or var (setq var calc-last-edited-variable))
(if var
(let* ((value (calc-var-value var)))
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index 67183fb..75e691a 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -470,17 +470,19 @@
(setq defv (calc-invent-independent-variables nv)))
(or defc
(setq defc (calc-invent-parameter-variables nc defv)))
- (let ((vars (read-string (format "Fitting variables (default %s; %s): "
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defv)
- ",")
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defc)
- ","))))
+ (let ((vars (read-string (format-prompt
+ "Fitting variables"
+ (format "%s; %s)"
+ (mapconcat 'symbol-name
+ (mapcar (function (lambda (v)
+ (nth 1 v)))
+ defv)
+ ",")
+ (mapconcat 'symbol-name
+ (mapcar (function (lambda (v)
+ (nth 1 v)))
+ defc)
+ ",")))))
(coefs nil))
(setq vars (if (string-match "\\[" vars)
(math-read-expr vars)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 5742614..20887af 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -994,7 +994,7 @@ pre-existing calendar windows."
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
(interactive (list (intern
- (completing-read "Date style: "
+ (completing-read (format-prompt "Date style" "american")
'("american" "european" "iso") nil t
nil nil "american"))))
(or (memq style '(american european iso))
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 182e99a..444a0e5 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -310,7 +310,7 @@ to the list. To include the phases of the moon, add
(lunar-phases)
-to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
+to the holiday list, where `lunar-phases' is an Emacs Lisp function that
you've written to return a (possibly empty) list of the relevant VISIBLE dates
with descriptive strings such as
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index d12feaa..2ee1d34 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -597,9 +597,9 @@ arguments of `completing-read'."
(defun timeclock-ask-for-project ()
"Ask the user for the project they are clocking into."
(completing-read
- (format "Clock into which project (default %s): "
- (or timeclock-last-project
- (car timeclock-project-list)))
+ (format-prompt "Clock into which project"
+ (or timeclock-last-project
+ (car timeclock-project-list)))
timeclock-project-list
nil nil nil nil
(or timeclock-last-project
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 0e4446f..3975a9b 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -4076,7 +4076,9 @@ regexp items."
((equal (file-name-extension f) "todt") "top")
((equal (file-name-extension f) "tody") "diary"))))
(push (cons (concat sf-name " (" type ")") f) falist)))
- (setq file (completing-read "Choose a filtered items file: " falist nil t
nil
+ (setq file (completing-read (format-prompt "Choose a filtered items file"
+ (caar falist))
+ falist nil t nil
'todo--fifiles-history (caar falist)))
(setq file (cdr (assoc-string file falist)))
(find-file file)
@@ -4724,9 +4726,8 @@ name in `todo-directory'. See also the documentation
string of
(todo-convert-legacy-date-time)))
(forward-line))
(setq file (concat todo-directory
- (read-string
- (format "Save file as (default \"%s\"): " default)
- nil nil default)
+ (read-string (format-prompt "Save file as" default)
+ nil nil default)
".todo"))
(unless (file-exists-p todo-directory)
(make-directory todo-directory))
@@ -6108,11 +6109,12 @@ Valid time strings are those matching
`diary-time-regexp'.
Typing `<return>' at the prompt returns the current time, if the
user option `todo-always-add-time-string' is non-nil, otherwise
the empty string (i.e., no time string)."
- (let (valid answer)
+ (let ((default (when todo-always-add-time-string
+ (format-time-string "%H:%M")))
+ valid answer)
(while (not valid)
- (setq answer (read-string "Enter a clock time: " nil nil
- (when todo-always-add-time-string
- (format-time-string "%H:%M"))))
+ (setq answer (read-string (format-prompt "Enter a clock time" default)
+ nil nil default))
(when (or (string= "" answer)
(string-match diary-time-regexp answer))
(setq valid t)))
diff --git a/lisp/cedet/semantic/symref/list.el
b/lisp/cedet/semantic/symref/list.el
index 23f5f89..fc7f9db 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -85,10 +85,12 @@ current project to find references to the input SYM. The
references are the organized by file and the name of the function
they are used in.
Display the references in `semantic-symref-results-mode'."
- (interactive (list (let ((tag (semantic-current-tag)))
- (read-string " Symrefs for: " nil nil
- (when tag
- (regexp-quote (semantic-tag-name
tag)))))))
+ (interactive (list (let* ((tag (semantic-current-tag))
+ (default (when tag
+ (regexp-quote
+ (semantic-tag-name tag)))))
+ (read-string (format-prompt " Symrefs for" default)
+ nil nil default))))
;; FIXME: Shouldn't the input be in Emacs regexp format, for
;; consistency? Converting it to extended is not hard.
(semantic-fetch-tags)
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 5a3c20c..34561a2 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -324,6 +324,13 @@ from which to start."
(while (< i end)
(pcase (aref string i)
(?\s (setq spaces (1+ spaces)))
+ ((pred (lambda (c) (and char-fold-symmetric
+ (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ (stringp search-whitespace-regexp)
+ (string-match-p search-whitespace-regexp
(char-to-string c)))))
+ (setq spaces (1+ spaces)))
(c (when (> spaces 0)
(push (char-fold--make-space-string spaces) out)
(setq spaces 0))
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index d4bec95..7191b93 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -327,9 +327,8 @@ With a prefix argument switch off tracing of procedure
PROC."
(interactive
(list (let ((current (symbol-at-point))
(action (if current-prefix-arg "Untrace" "Trace")))
- (if current
- (read-string (format "%s procedure [%s]: " action current) nil
nil (symbol-name current))
- (read-string (format "%s procedure: " action))))
+ (read-string (format-prompt "%s procedure" current action)
+ nil nil (and current (symbol-name current))))
current-prefix-arg))
(when (= (length proc) 0)
(error "Invalid procedure name"))
diff --git a/lisp/completion.el b/lisp/completion.el
index b286474..ed13455 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1276,11 +1276,7 @@ String must be longer than
`completion-prefix-min-length'."
(defun interactive-completion-string-reader (prompt)
(let* ((default (symbol-under-or-before-point))
- (new-prompt
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (read (completing-read new-prompt cmpl-obarray)))
+ (read (completing-read (format-prompt prompt default) cmpl-obarray)))
(if (zerop (length read)) (setq read (or default "")))
(list read)))
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 7c60916..0eb4dbf 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -51,6 +51,25 @@
ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(defalias sym e))))
'(defcustom defface defgroup)))
+(defun custom--get-def (expr)
+ (if (not (memq (car-safe expr)
+ '( define-minor-mode define-globalized-minor-mode)))
+ expr
+ ;; For define-minor-mode, we don't want to evaluate the whole
+ ;; expression, because it tends to define functions which aren't
+ ;; usable (because they call other functions that were skipped).
+ ;; Concretely it gave us an error
+ ;; "void-function bug-reference--run-auto-setup"
+ ;; when subsequently loading `cus-load.el'.
+ (let ((es (list (macroexpand-all expr)))
+ defs)
+ (while es
+ (let ((e (pop es)))
+ (pcase e
+ (`(progn . ,exps) (setq es (append exps es)))
+ (`(custom-declare-variable . ,_) (push e defs)))))
+ (macroexp-progn (nreverse defs)))))
+
(defun custom-make-dependencies ()
"Batch function to extract custom dependencies from .el files.
Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
@@ -100,15 +119,19 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(setq name (intern name)))
(condition-case nil
(while (re-search-forward
- "^(def\\(custom\\|face\\|group\\)" nil t)
+
"^(def\\(custom\\|face\\|group\\|ine\\(?:-globalized\\)?-minor-mode\\)" nil t)
(beginning-of-line)
(let ((type (match-string 1))
- (expr (read (current-buffer))))
+ (expr (custom--get-def (read (current-buffer)))))
(condition-case nil
- (let ((custom-dont-initialize t))
+ (let ((custom-dont-initialize t)
+ (sym (nth 1 expr)))
+ (put (if (eq (car-safe sym) 'quote)
+ (cadr sym)
+ sym)
+ 'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
- (put (nth 1 expr) 'custom-where name)
(eval expr))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
@@ -149,7 +172,8 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(when found
(push (cons (symbol-name symbol)
(with-output-to-string
- (prin1 (sort found 'string<)))) alist))))))
+ (prin1 (sort found #'string<))))
+ alist))))))
(dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
(insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n")))
(insert "\
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 7153ba4..6d0ec5d 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -408,10 +408,6 @@ Use group `text' for this instead. This group is
deprecated."
"Input from the menus."
:group 'environment)
-(defgroup dnd nil
- "Handling data from drag and drop."
- :group 'environment)
-
(defgroup auto-save nil
"Preventing accidental loss of data."
:group 'files)
@@ -485,10 +481,8 @@ Return a list suitable for use in `interactive'."
(default (and (symbolp v) (custom-variable-p v) (symbol-name v)))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if default (format "Customize variable (default %s): " default)
- "Customize variable: ")
- obarray 'custom-variable-p t nil nil default))
+ (setq val (completing-read (format-prompt "Customize variable" default)
+ obarray 'custom-variable-p t nil nil default))
(list (if (equal val "")
(if (symbolp v) v nil)
(intern val)))))
@@ -561,7 +555,7 @@ value unless you are sure you know what it does."
(unless no-suffix
(goto-char (point-max))
(insert "..."))
- (buffer-string)))))
+ (propertize (buffer-string) 'custom-data symbol)))))
(defcustom custom-unlispify-tag-names t
"Display tag names as words instead of symbols if non-nil."
@@ -1084,9 +1078,7 @@ for the MODE to customize."
(if (and group (not current-prefix-arg))
major-mode
(intern
- (completing-read (if group
- (format "Mode (default %s): " major-mode)
- "Mode: ")
+ (completing-read (format-prompt "Mode" (and group major-mode))
obarray
'custom-group-of-mode
t nil nil (if group (symbol-name major-mode))))))))
@@ -1219,8 +1211,8 @@ that were added or redefined since that version."
(interactive
(list
(read-from-minibuffer
- (format "Customize options changed, since version (default %s): "
- customize-changed-options-previous-release))))
+ (format-prompt "Customize options changed, since version"
+ customize-changed-options-previous-release))))
(if (equal since-version "")
(setq since-version nil)
(unless (condition-case nil
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 82f4455..3ee877e 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -153,10 +153,8 @@ the string of command switches used as the third argument
of `diff'."
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
- (read-file-name
- (format "Diff %s with%s: " current
- (if default (format " (default %s)" default) ""))
- target-dir default t))
+ (read-file-name (format-prompt "Diff %s with" default current)
+ target-dir default t))
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 05c5a70..80a266f 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -327,21 +327,19 @@ See also the functions:
(when file
(file-name-extension file))))
(suffix
- (read-string (format "%s extension%s: "
- (if (equal current-prefix-arg '(4))
- "UNmarking"
- "Marking")
- (if default
- (format " (default %s)" default)
- "")) nil nil default))
+ (read-string (format-prompt
+ "%s extension" default
+ (if (equal current-prefix-arg '(4))
+ "UNmarking"
+ "Marking"))
+ nil nil default))
(marker
(pcase current-prefix-arg
('(4) ?\s)
('(16)
(let* ((dflt (char-to-string dired-marker-char))
(input (read-string
- (format
- "Marker character to use (default %s): " dflt)
+ (format-prompt "Marker character to use" dflt)
nil nil dflt)))
(aref input 0)))
(_ dired-marker-char))))
diff --git a/lisp/dired.el b/lisp/dired.el
index e4bc4de..733d83e 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -896,8 +896,9 @@ ERROR can be a string with the error message."
(if (next-read-file-uses-dialog-p)
(read-directory-name (format "Dired %s(directory): " str)
nil default-directory nil)
- (read-file-name (format "Dired %s(directory): " str)
- nil default-directory nil)))))
+ (read-file-name (format-prompt "Dired %s(directory)"
+ default-directory str)
+ nil default-directory)))))
;; We want to switch to a more sophisticated version of
;; dired-read-dir-and-switches like the following, if there is a way
diff --git a/lisp/display-fill-column-indicator.el
b/lisp/display-fill-column-indicator.el
index 3f947bd..e1395f0 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -57,12 +57,13 @@ See Info node `Displaying Boundaries' for details."
(progn
(setq display-fill-column-indicator t)
(unless display-fill-column-indicator-character
- (if (and (char-displayable-p ?\u2502)
- (or (not (display-graphic-p))
- (eq (aref (query-font (car (internal-char-font nil
?\u2502))) 0)
- (face-font 'default))))
- (setq display-fill-column-indicator-character ?\u2502)
- (setq display-fill-column-indicator-character ?|))))
+ (setq display-fill-column-indicator-character
+ (if (and (char-displayable-p ?\u2502)
+ (or (not (display-graphic-p))
+ (eq (aref (query-font (car (internal-char-font
nil ?\u2502))) 0)
+ (face-font 'default))))
+ ?\u2502
+ ?|))))
(setq display-fill-column-indicator nil)))
(defun display-fill-column-indicator--turn-on ()
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 1d0e26c..815a4af 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,4 +1,4 @@
-;;; dnd.el --- drag and drop support
+;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
@@ -33,6 +33,9 @@
;;; Customizable variables
+(defgroup dnd nil
+ "Handling data from drag and drop."
+ :group 'environment)
;;;###autoload
(defcustom dnd-protocol-alist
@@ -54,14 +57,13 @@ If no match is found, the URL is inserted as text by
calling `dnd-insert-text'.
The function shall return the action done (move, copy, link or private)
if some action was made, or nil if the URL is ignored."
:version "22.1"
- :type '(repeat (cons (regexp) (function)))
- :group 'dnd)
+ :type '(repeat (cons (regexp) (function))))
(defcustom dnd-open-remote-file-function
(if (eq system-type 'windows-nt)
- 'dnd-open-local-file
- 'dnd-open-remote-url)
+ #'dnd-open-local-file
+ #'dnd-open-remote-url)
"The function to call when opening a file on a remote machine.
The function will be called with two arguments, URI and ACTION.
See `dnd-open-file' for details.
@@ -71,15 +73,13 @@ Predefined functions are `dnd-open-local-file' and
`dnd-open-remote-url'.
is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
and is the default except for MS-Windows."
:version "22.1"
- :type 'function
- :group 'dnd)
+ :type 'function)
(defcustom dnd-open-file-other-window nil
"If non-nil, always use find-file-other-window to open dropped files."
:version "22.1"
- :type 'boolean
- :group 'dnd)
+ :type 'boolean)
;; Functions
@@ -133,7 +133,8 @@ Return nil if URI is not a local file."
(string-equal sysname-no-dot hostname)))
(concat "file://" (substring uri (+ 7 (length hostname))))))))
-(defsubst dnd-unescape-uri (uri)
+(defun dnd--unescape-uri (uri)
+ ;; Merge with corresponding code in URL library.
(replace-regexp-in-string
"%[[:xdigit:]][[:xdigit:]]"
(lambda (arg)
@@ -157,7 +158,7 @@ Return nil if URI is not a local file."
'utf-8
(or file-name-coding-system
default-file-name-coding-system))))
- (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding)))
+ (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding)))
(when (and f must-exist (not (file-readable-p f)))
(setq f nil))
f))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index deac458..0ebd274 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1856,7 +1856,7 @@ function at point for which PREDICATE returns non-nil)."
"There are no qualifying advised functions")))
(let* ((function
(completing-read
- (format "%s (default %s): " (or prompt "Function") default)
+ (format-prompt (or prompt "Function") default)
ad-advised-functions
(if predicate
(lambda (function)
@@ -1884,7 +1884,7 @@ class of FUNCTION)."
(cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
- (format "%s (default %s): " (or prompt "Class") default)
+ (format-prompt (or prompt "Class") default)
ad-advice-class-completion-table nil t)))
(if (equal class "")
default
@@ -1902,8 +1902,8 @@ An optional PROMPT is used to prompt for the name."
(error "ad-read-advice-name: `%s' has no %s advice"
function class)
(car (car name-completion-table))))
- (prompt (format "%s (default %s): " (or prompt "Name") default))
- (name (completing-read prompt name-completion-table nil t)))
+ (name (completing-read (format-prompt (or prompt "Name") default)
+ name-completion-table nil t)))
(if (equal name "")
(intern default)
(intern name))))
@@ -1923,9 +1923,9 @@ be used to prompt for the function."
(defun ad-read-regexp (&optional prompt)
"Read a regular expression from the minibuffer."
(let ((regexp (read-from-minibuffer
- (concat (or prompt "Regular expression")
- (if (equal ad-last-regexp "") ": "
- (format " (default %s): " ad-last-regexp))))))
+ (format-prompt (or prompt "Regular expression")
+ (and (not (equal ad-last-regexp ""))
+ ad-last-regexp)))))
(setq ad-last-regexp
(if (equal regexp "") ad-last-regexp regexp))))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 1029b52..23121c2 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1573,7 +1573,8 @@ mouse-[0-3]\\)\\)\\>"))
;; a prefix.
(let ((disambiguate
(completing-read
- "Disambiguating Keyword (default variable): "
+ (format-prompt "Disambiguating Keyword"
+ "variable")
'(("function") ("command") ("variable")
("option") ("symbol"))
nil t nil nil "variable")))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index ed28997..1bdb2a3 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -653,9 +653,7 @@ Redefining FUNCTION also cancels it."
(when (special-form-p fn)
(setq fn nil))
(setq val (completing-read
- (if fn
- (format "Debug on entry to function (default %s): " fn)
- "Debug on entry to function: ")
+ (format-prompt "Debug on entry to function" fn)
obarray
#'(lambda (symbol)
(and (fboundp symbol)
@@ -758,8 +756,7 @@ another symbol also cancels it."
(let* ((var-at-point (variable-at-point))
(var (and (symbolp var-at-point) var-at-point))
(val (completing-read
- (concat "Debug when setting variable"
- (if var (format " (default %s): " var) ": "))
+ (format-prompt "Debug when setting variable" var)
obarray #'boundp
t nil nil (and var (symbol-name var)))))
(list (if (equal val "") var (intern val)))))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index aa8b248..7e7db7b 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -59,10 +59,9 @@ If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol."
(interactive
(let* ((fn (function-called-at-point))
- (prompt (if fn (format "Disassemble function (default %s): " fn)
- "Disassemble function: "))
(def (and fn (symbol-name fn))))
- (list (intern (completing-read prompt obarray 'fboundp t nil nil def))
+ (list (intern (completing-read (format-prompt "Disassemble function" fn)
+ obarray 'fboundp t nil nil def))
nil 0 t)))
(if (and (consp object) (not (functionp object)))
(setq object `(lambda () ,object)))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 24c9e79..e3eb929 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,4 +1,4 @@
-;;; easy-mmode.el --- easy definition for major and minor modes
+;;; easy-mmode.el --- easy definition for major and minor modes -*-
lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
@@ -157,9 +157,6 @@ BODY contains code to execute each time the mode is enabled
or disabled.
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
- Defaults to MODE without the possible trailing \"-mode\".
- Don't use this default group name unless you have written a
- `defgroup' to define that group properly.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
@@ -262,12 +259,6 @@ For example, you could write
(unless initialize
(setq initialize '(:initialize 'custom-initialize-default)))
- (unless group
- ;; We might as well provide a best-guess default group.
- (setq group
- `(:group ',(intern (replace-regexp-in-string
- "-mode\\'" "" mode-name)))))
-
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f68c0fa..a94978a 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -342,9 +342,9 @@ Use optional LIST if provided instead."
(interactive
(list
(intern
- (completing-read "Master function: " obarray
- #'elp--instrumented-p
- t nil nil (if elp-master (symbol-name elp-master))))))
+ (let ((default (if elp-master (symbol-name elp-master))))
+ (completing-read (format-prompt "Master function" default)
+ obarray #'elp--instrumented-p t nil nil default)))))
;; When there's a master function, recording is turned off by default.
(setq elp-master funsym
elp-record-p nil)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 241eece..3c347c0 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1635,9 +1635,7 @@ Signals an error if no test name was read."
nil)))
(ert-test (setq default (ert-test-name default))))
(when add-default-to-prompt
- (setq prompt (if (null default)
- (format "%s: " prompt)
- (format "%s (default %s): " prompt default))))
+ (setq prompt (format-prompt prompt default)))
(let ((input (completing-read prompt obarray #'ert-test-boundp
t nil history default nil)))
;; completing-read returns an empty string if default was nil and
@@ -2023,9 +2021,7 @@ and how to display message."
(car ert--selector-history)
"t")))
(read
- (completing-read (if (null default)
- "Run tests: "
- (format "Run tests (default %s): " default))
+ (completing-read (format-prompt "Run tests" default)
obarray #'ert-test-boundp nil nil
'ert--selector-history default nil)))
nil))
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 60b1625..9802bd4 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -319,9 +319,7 @@ if non-nil)."
(thing-at-point 'symbol))))
(when (and def (not (test-completion def table)))
(setq def nil))
- (completing-read (if def
- (format "Library name (default %s): " def)
- "Library name: ")
+ (completing-read (format-prompt "Library name" def)
table nil nil nil nil def)))
;;;###autoload
@@ -489,12 +487,10 @@ otherwise uses `variable-at-point'."
(prompt-type (cdr (assq type '((nil . "function")
(defvar . "variable")
(defface . "face")))))
- (prompt (concat "Find " prompt-type
- (and symb (format " (default %s)" symb))
- ": "))
(enable-recursive-minibuffers t))
(list (intern (completing-read
- prompt obarray predicate
+ (format-prompt "Find %s" symb prompt-type)
+ obarray predicate
t nil nil (and symb (symbol-name symb)))))))
(defun find-function-do-it (symbol type switch-fn)
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 78d86b9..5470b85 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -417,6 +417,17 @@ The return value is the last VAL in the list.
`(delq ,p ,getter))))))
,v))))))))))
+(gv-define-expander plist-get
+ (lambda (do plist prop)
+ (macroexp-let2 macroexp-copyable-p key prop
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (funcall do
+ `(car ,p)
+ (lambda (val)
+ `(if ,p
+ (setcar ,p ,val)
+ ,(funcall setter `(cons ,key (cons ,val
,getter)))))))))))
;;; Some occasionally handy extensions.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index c20659a..81e1400 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2348,10 +2348,7 @@ will be deleted."
(setq guess nil))
(setq packages (mapcar #'symbol-name packages))
(let ((val
- (completing-read (if guess
- (format "Describe package (default %s): "
- guess)
- "Describe package: ")
+ (completing-read (format-prompt "Describe package" guess)
packages nil t nil nil (when guess
(symbol-name guess)))))
(list (and (> (length val) 0) (intern val)))))))
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 0e1618e..0672f60 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -489,7 +489,7 @@ Optional argument SYNTAX must be specified if called
non-interactively."
(interactive
(list (intern
(completing-read
- (format "Select syntax (default %s): " reb-re-syntax)
+ (format-prompt "Select syntax" reb-re-syntax)
'(read string sregex rx)
nil t nil nil (symbol-name reb-re-syntax)
'reb-change-syntax-hist))))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 38a7b8b..1b700af 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -2120,10 +2120,9 @@ position corresponding to each rule."
(throw 'found (list kind token
(or (nth 3 rewrite) res)))))))))
(default-new (smie-config--guess-value sig))
- (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: "
- (nth 0 sig) (nth 1 sig) (nth 2 sig)
- (if (not default-new) ""
- (format " (default %S)" default-new)))
+ (newstr (read-string (format-prompt
+ "Adjust rule (%S %S -> %S) to" default-new
+ (nth 0 sig) (nth 1 sig) (nth 2 sig))
nil nil (format "%S" default-new)))
(new (car (read-from-string newstr))))
(let ((old (rassoc sig smie-config--buffer-local)))
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 4ebb7ff..6273056 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -265,20 +265,13 @@ be printed along with the arguments in the trace."
If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
\(Lisp expression). Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
(cons
- (let ((default (function-called-at-point))
- (beg (string-match ":[ \t]*\\'" prompt)))
- (intern (completing-read (if default
- (format
- "%s (default %s)%s"
- (substring prompt 0 beg)
- default
- (if beg (substring prompt beg) ": "))
- prompt)
+ (let ((default (function-called-at-point)))
+ (intern (completing-read (format-prompt prompt default)
obarray 'fboundp t nil nil
(if default (symbol-name default)))))
(when current-prefix-arg
(list
- (read-buffer "Output to buffer: " trace-buffer)
+ (read-buffer (format-prompt "Output to buffer" trace-buffer))
(let ((exp
(let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Context expression: "
@@ -308,7 +301,7 @@ functions that switch buffers, or do any other
display-oriented
stuff - use `trace-function-background' instead.
To stop tracing a function, use `untrace-function' or `untrace-all'."
- (interactive (trace--read-args "Trace function: "))
+ (interactive (trace--read-args "Trace function"))
(trace-function-internal function buffer nil context))
;;;###autoload
@@ -316,7 +309,7 @@ To stop tracing a function, use `untrace-function' or
`untrace-all'."
"Trace calls to function FUNCTION, quietly.
This is like `trace-function-foreground', but without popping up
the output buffer or changing the window configuration."
- (interactive (trace--read-args "Trace function in background: "))
+ (interactive (trace--read-args "Trace function in background"))
(trace-function-internal function buffer t context))
;;;###autoload
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 3a568cb..e10c149 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -292,14 +292,17 @@ entirely by setting `warning-suppress-types' or
(insert (format (nth 1 level-info)
(format warning-type-format typename))
message)
- (insert " ")
- (insert-button "Disable showing"
- 'type 'warning-suppress-warning
- 'warning-type type)
- (insert " ")
- (insert-button "Disable logging"
- 'type 'warning-suppress-log-warning
- 'warning-type type)
+ ;; Don't output the buttons when doing batch compilation
+ ;; and similar.
+ (unless noninteractive
+ (insert " ")
+ (insert-button "Disable showing"
+ 'type 'warning-suppress-warning
+ 'warning-type type)
+ (insert " ")
+ (insert-button "Disable logging"
+ 'type 'warning-suppress-log-warning
+ 'warning-type type))
(funcall newline)
(when (and warning-fill-prefix (not (string-match "\n" message)))
(let ((fill-prefix warning-fill-prefix)
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 5f393a0..ba75a93 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -176,11 +176,12 @@ Return a value appropriate for
`kill-buffer-query-functions' (which see)."
arg)
((and (eq arg current-prefix-arg) (consp current-prefix-arg))
;; called with C-u M-x emacs-lock-mode, so ask the user
- (intern (completing-read "Locking mode: "
- '("all" "exit" "kill")
- nil t nil nil
- (symbol-name
- emacs-lock-default-locking-mode))))
+ (intern (completing-read
+ (format-prompt "Locking mode"
+ emacs-lock-default-locking-mode)
+ '("all" "exit" "kill")
+ nil t nil nil
+ (symbol-name emacs-lock-default-locking-mode))))
((eq mode t)
;; turn on, so use previous setting, or customized default
(or emacs-lock--old-mode emacs-lock-default-locking-mode))
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 663995a..d2c6dd0 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1150,9 +1150,9 @@ The numbers are formatted according to the FORMAT string."
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(string-to-number
- (read-string "Start value: (0) " nil nil "0")))
+ (read-string (format-prompt "Start value" 0) nil nil "0")))
(string-to-number
- (read-string "Increment: (1) " nil nil "1"))
+ (read-string (format-prompt "Increment" 1) nil nil "1"))
(read-string (concat "Format: (" cua--rectangle-seq-format ") "))))
(if (= (length format) 0)
(setq format cua--rectangle-seq-format)
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 2fffcbb..5dd81fa 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -510,7 +510,8 @@
(if window-system (concat "-" (upcase (symbol-name
window-system))))
"-keys")))
(set-visited-file-name
- (read-file-name (format "Save key mapping to file (default %s): " file)
nil file)))
+ (read-file-name (format-prompt "Save key mapping to file" file)
+ nil file)))
(save-buffer)
(message "That's it! Press any key to exit")
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 477f148..1bce986 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -516,8 +516,8 @@ PROC is the server process."
(filename (or file (plist-get elt :file) "unknown")))
(if elt
(let* ((file (read-file-name
- (format "Local filename (default %s): "
- (file-name-nondirectory filename))
+ (format-prompt "Local filename"
+ (file-name-nondirectory filename))
(or erc-dcc-get-default-directory
default-directory)
(expand-file-name (file-name-nondirectory filename)
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
new file mode 100644
index 0000000..ab98836
--- /dev/null
+++ b/lisp/erc/erc-status-sidebar.el
@@ -0,0 +1,308 @@
+;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC
+
+;; Copyright (C) 2017, 2020 Free Software Foundation, Inc.
+
+;; Author: Andrew Barbarello
+;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; URL: https://github.com/drewbarbs/erc-status-sidebar
+
+;; 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:
+
+;; This package provides a HexChat-like sidebar for joined channels in
+;; ERC. It relies on the `erc-track' module, and displays all of the
+;; same information that `erc-track' does in the mode line, but in an
+;; alternative format in form of a sidebar.
+
+;; Shout out to sidebar.el <https://github.com/sebastiencs/sidebar.el>
+;; and outline-toc.el <https://github.com/abingham/outline-toc.el> for
+;; the sidebar window management ideas.
+
+;; Usage:
+
+;; Use M-x erc-status-sidebar-open RET to open the ERC status sidebar
+;; in the current frame. Make sure that the `erc-track' module is
+;; active (this is the default).
+
+;; Use M-x erc-status-sidebar-close RET to close the sidebar on the
+;; current frame. With a prefix argument, it closes the sidebar on
+;; all frames.
+
+;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and
+;; close the sidebar on all frames.
+
+;;; Code:
+
+(require 'erc)
+(require 'erc-track)
+(require 'fringe)
+(require 'seq)
+
+(defgroup erc-status-sidebar nil
+ "A sidebar for ERC channel status."
+ :group 'convenience)
+
+(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
+ "Name of the sidebar buffer."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-mode-line-format "ERC Status"
+ "Mode line format for the status sidebar."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-header-line-format nil
+ "Header line format for the status sidebar."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-width 15
+ "Default width of the sidebar (in columns)."
+ :type 'number
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-channel-sort
+ 'erc-status-sidebar-default-chansort
+ "Sorting function used to determine order of channels in the sidebar."
+ :type 'function
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-channel-format
+ 'erc-status-sidebar-default-chan-format
+ "Function used to format channel names for display in the sidebar."
+ :type 'function
+ :group 'erc-status-sidebar)
+
+(defun erc-status-sidebar-display-window ()
+ "Display the status buffer in a side window. Return the new window."
+ (display-buffer
+ (erc-status-sidebar-get-buffer)
+ `(display-buffer-in-side-window . ((side . left)
+ (window-width .
,erc-status-sidebar-width)))))
+
+(defun erc-status-sidebar-get-window (&optional no-creation)
+ "Return the created/existing window displaying the status buffer.
+
+If NO-CREATION is non-nil, the window is not created."
+ (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name)))
+ (unless (or sidebar-window no-creation)
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (setq-local vertical-scroll-bar nil))
+ (setq sidebar-window (erc-status-sidebar-display-window))
+ (set-window-dedicated-p sidebar-window t)
+ (set-window-parameter sidebar-window 'no-delete-other-windows t)
+ ;; Don't cycle to this window with `other-window'.
+ (set-window-parameter sidebar-window 'no-other-window t)
+ (internal-show-cursor sidebar-window nil)
+ (set-window-fringes sidebar-window 0 0)
+ ;; Set a custom display table so the window doesn't show a
+ ;; truncation symbol when a channel name is too big.
+ (let ((dt (make-display-table)))
+ (set-window-display-table sidebar-window dt)
+ (set-display-table-slot dt 'truncation ?\ )))
+ sidebar-window))
+
+(defun erc-status-sidebar-buffer-exists-p ()
+ "Check if the sidebar buffer exists."
+ (get-buffer erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-get-buffer ()
+ "Return the sidebar buffer, creating it if it doesn't exist."
+ (get-buffer-create erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-close (&optional all-frames)
+ "Close the sidebar.
+
+If called with prefix argument (ALL-FRAMES non-nil), the sidebar
+will be closed on all frames.
+
+The erc-status-sidebar buffer is left alone, but the window
+containing it on the current frame is closed. See
+`erc-status-sidebar-kill'."
+ (interactive "P")
+ (mapcar #'delete-window
+ (get-buffer-window-list (erc-status-sidebar-get-buffer)
+ nil (if all-frames t))))
+
+(defmacro erc-status-sidebar-writable (&rest body)
+ "Make the status buffer writable while executing BODY."
+ `(let ((buffer-read-only nil))
+ ,@body))
+
+;;;###autoload
+(defun erc-status-sidebar-open ()
+ "Open or create a sidebar."
+ (interactive)
+ (save-excursion
+ (let ((sidebar-exists (erc-status-sidebar-buffer-exists-p))
+ (sidebar-buffer (erc-status-sidebar-get-buffer))
+ (sidebar-window (erc-status-sidebar-get-window)))
+ (unless sidebar-exists
+ (with-current-buffer sidebar-buffer
+ (erc-status-sidebar-mode)
+ (erc-status-sidebar-refresh))))))
+
+;;;###autoload
+(defun erc-status-sidebar-toggle ()
+ "Toggle the sidebar open/closed on the current frame."
+ (interactive)
+ (if (get-buffer-window erc-status-sidebar-buffer-name nil)
+ (erc-status-sidebar-close)
+ (erc-status-sidebar-open)))
+
+(defun erc-status-sidebar-get-channame (buffer)
+ "Return name of BUFFER with all leading \"#\" characters removed."
+ (let ((s (buffer-name buffer)))
+ (if (string-match "^#\\{1,2\\}" s)
+ (setq s (replace-match "" t t s)))
+ (downcase s)))
+
+(defun erc-status-sidebar-default-chansort (chanlist)
+ "Sort CHANLIST case-insensitively for display in the sidebar."
+ (sort chanlist (lambda (x y)
+ (string< (erc-status-sidebar-get-channame x)
+ (erc-status-sidebar-get-channame y)))))
+
+(defun erc-status-sidebar-default-chan-format (channame
+ &optional num-messages erc-face)
+ "Format CHANNAME for display in the sidebar.
+
+If NUM-MESSAGES is non-nil, append it to the channel name. If
+ERC-FACE is non-nil, apply it to channel name. If it is equal to
+`erc-default-face', also apply bold property to make the channel
+name stand out."
+ (when num-messages
+ (setq channame (format "%s [%d]" channame num-messages)))
+ (when erc-face
+ (put-text-property 0 (length channame) 'face erc-face channame)
+ (when (eq erc-face 'erc-default-face)
+ (add-face-text-property 0 (length channame) 'bold t channame)))
+ channame)
+
+(defun erc-status-sidebar-refresh ()
+ "Update the content of the sidebar."
+ (interactive)
+ (let ((chanlist (apply erc-status-sidebar-channel-sort
+ (erc-channel-list nil) nil)))
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (erc-status-sidebar-writable
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (dolist (chanbuf chanlist)
+ (let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf))
+ erc-modified-channels-alist))
+ (count (if tup (cadr tup)))
+ (face (if tup (cddr tup)))
+ (channame (apply erc-status-sidebar-channel-format
+ (buffer-name chanbuf) count face nil))
+ (cnlen (length channame)))
+ (put-text-property 0 cnlen 'erc-buf chanbuf channame)
+ (put-text-property 0 cnlen 'mouse-face 'highlight channame)
+ (put-text-property
+ 0 cnlen 'help-echo
+ "mouse-1: switch to buffer in other window" channame)
+ (insert channame "\n")))))))
+
+(defun erc-status-sidebar-kill ()
+ "Close the ERC status sidebar and its buffer."
+ (interactive)
+ (ignore-errors (kill-buffer erc-status-sidebar-buffer-name)))
+
+(defun erc-status-sidebar-click (event)
+ "Handle click EVENT in `erc-status-sidebar-mode-map'."
+ (interactive "e")
+ (save-excursion
+ (let ((window (posn-window (event-end event)))
+ (pos (posn-point (event-end event))))
+ (set-buffer (window-buffer window))
+ (let ((buf (get-text-property pos 'erc-buf)))
+ (when buf
+ (select-window window)
+ (switch-to-buffer-other-window buf))))))
+
+(defvar erc-status-sidebar-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map [mouse-1] #'erc-status-sidebar-click)
+ map))
+
+(defvar erc-status-sidebar-refresh-triggers
+ '(erc-track-list-changed-hook
+ erc-join-hook
+ erc-part-hook
+ erc-kill-buffer-hook
+ erc-kill-channel-hook
+ erc-kill-server-hook
+ erc-kick-hook
+ erc-disconnected-hook
+ erc-quit-hook))
+
+(defun erc-status-sidebar--post-refresh (&rest ignore)
+ "Schedule sidebar refresh for execution after command stack is cleared.
+
+Ignore arguments in IGNORE, allowing this function to be added to
+hooks that invoke it with arguments."
+ (run-at-time 0 nil #'erc-status-sidebar-refresh))
+
+(defun erc-status-sidebar-mode--unhook ()
+ "Remove hooks installed by `erc-status-sidebar-mode'."
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (remove-hook hk #'erc-status-sidebar--post-refresh))
+ (remove-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size))
+
+(defun erc-status-sidebar-set-window-preserve-size ()
+ "Tell Emacs to preserve the current height/width of the ERC sidebar window.
+
+Note that preserve status needs to be reset when the window is
+manually resized, so `erc-status-sidebar-mode' adds this function
+to the `window-configuration-change-hook'."
+ (when (and (eq (selected-window) (erc-status-sidebar-get-window))
+ (fboundp 'window-preserve-size))
+ (unless (eq (window-total-width) (window-min-size nil t))
+ (apply 'window-preserve-size (selected-window) t t nil))))
+
+(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
+ "Major mode for ERC status sidebar"
+ ;; Don't scroll the buffer horizontally, if a channel name is
+ ;; obscured then the window can be resized.
+ (setq-local auto-hscroll-mode nil)
+ (setq cursor-type nil
+ buffer-read-only t
+ mode-line-format erc-status-sidebar-mode-line-format
+ header-line-format erc-status-sidebar-header-line-format)
+ (erc-status-sidebar-set-window-preserve-size)
+
+ (add-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size nil t)
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (add-hook hk #'erc-status-sidebar--post-refresh))
+
+ ;; `change-major-mode-hook' is run *before* the
+ ;; erc-status-sidebar-mode initialization code, so it won't undo the
+ ;; add-hook's we did in the previous expressions.
+ (add-hook 'change-major-mode-hook #'erc-status-sidebar-mode--unhook nil t)
+ (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t)
+ :group 'erc-status-sidebar)
+
+(provide 'erc-status-sidebar)
+;;; erc-status-sidebar.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8712113..e7e43f8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4072,7 +4072,8 @@ If `point' is at the beginning of a channel name, use
that as default."
(table (when (erc-server-buffer-live-p)
(set-buffer (process-buffer erc-server-process))
erc-channel-list)))
- (completing-read "Join channel: " table nil nil nil nil chnl))
+ (completing-read (format-prompt "Join channel" chnl)
+ table nil nil nil nil chnl))
(when (or current-prefix-arg erc-prompt-for-channel-key)
(read-from-minibuffer "Channel key (RET for none): " nil))))
(erc-cmd-JOIN channel (when (>= (length key) 1) key)))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index ecdfd28..e0e8634 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -1018,6 +1018,7 @@ This function could be in the list
`eshell-output-filter-functions'."
(location . ,default-directory)
(handler . eshell-bookmark-jump)))
+;;;###autoload
(defun eshell-bookmark-jump (bookmark)
"Default bookmark handler for Eshell buffers."
(let ((default-directory (bookmark-prop-get bookmark 'location)))
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 419b761..3ed4b54 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -445,7 +445,7 @@ sets the CHARSET property of the character at point."
(interactive (list (progn
(barf-if-buffer-read-only)
(read-charset
- (format "Use charset (default %s): " (charset-after))
+ (format-prompt "Use charset" (charset-after))
(charset-after)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
diff --git a/lisp/faces.el b/lisp/faces.el
index ba85973..7c23e58 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1212,10 +1212,7 @@ Value is the new attribute value."
(setq name (concat (upcase (substring name 0 1)) (substring name 1)))
(let* ((completion-ignore-case t)
(value (completing-read
- (format-message (if default
- "%s for face `%s' (default %s): "
- "%s for face `%s': ")
- name face default)
+ (format-prompt "%s for face `%s'" default name face)
completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index af7d84c..3e65c68 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1751,7 +1751,7 @@ Function CONT is applied to the entry chosen by the user."
;; Bug: prompting may assume unique strings, no "".
(setq choice
(completing-read
- (format "%s (default %s): " title (car (car alist)))
+ (format-prompt title (car (car alist)))
alist nil t
;; (cons (car (car alist)) 0)
nil)))
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 5d86362..911e7ba 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -45,9 +45,7 @@ Intended to be used in the `interactive' spec of
(symbol-name default)))
(variable
(completing-read
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt))
+ (format-prompt prompt default)
obarray
(lambda (sym)
(or (custom-variable-p sym)
@@ -65,9 +63,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(value
(completing-read
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
+ (format-prompt "Add %s with value" default variable)
obarray
(lambda (sym)
(string-match-p "-mode\\'" (symbol-name sym)))
@@ -79,11 +75,8 @@ Intended to be used in the `interactive' spec of
((eq variable 'coding)
(let ((default (and (symbolp buffer-file-coding-system)
(symbol-name buffer-file-coding-system))))
- (read-coding-system
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
- default)))
+ (read-coding-system (format-prompt "Add %s with value" default variable)
+ default)))
(t
(let ((default (format "%S"
(cond ((eq variable 'unibyte) t)
@@ -102,9 +95,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(mode
(completing-read
- (if default
- (format "Mode or subdirectory (default %s): " default)
- (format "Mode or subdirectory: "))
+ (format-prompt "Mode or subdirectory" default)
obarray
(lambda (sym)
(and (string-match-p "-mode\\'" (symbol-name sym))
diff --git a/lisp/files.el b/lisp/files.el
index bc590d3..61e7e21 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1566,8 +1566,8 @@ use with M-x."
(and (not (memq 'eight-bit-control charsets))
(not (memq 'eight-bit-graphic charsets)))))
(setq from-coding (read-coding-system
- (format "Recode filename %s from (default %s): "
- filename default-coding)
+ (format-prompt "Recode filename %s from"
+ filename default-coding)
default-coding))
(setq from-coding (read-coding-system
(format "Recode filename %s from: " filename))))
@@ -1579,8 +1579,8 @@ use with M-x."
(format "Recode filename %s from %s to: "
filename from-coding)))
(setq to-coding (read-coding-system
- (format "Recode filename %s from %s to (default %s): "
- filename from-coding default-coding)
+ (format-prompt "Recode filename %s from %s to"
+ default-coding filename from-coding)
default-coding)))
(list filename from-coding to-coding)))
@@ -4530,13 +4530,12 @@ Interactively, confirmation is required unless you
supply a prefix argument."
;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
- (read-file-name "Write file: "
- nil nil nil nil)
- (read-file-name "Write file: " default-directory
- (expand-file-name
- (file-name-nondirectory (buffer-name))
- default-directory)
- nil nil))
+ (read-file-name "Write file: ")
+ (read-file-name
+ (format-prompt "Write file" (file-name-nondirectory (buffer-name)))
+ default-directory
+ (expand-file-name (file-name-nondirectory (buffer-name))
+ default-directory)))
(not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
@@ -5274,10 +5273,13 @@ Before and after saving the buffer, this function runs
(unless (run-hook-with-args-until-success 'write-contents-functions)
;; If buffer has no file name, ask user for one.
(or buffer-file-name
- (let ((filename
- (expand-file-name
- (read-file-name "File to save in: "
- nil (expand-file-name
(buffer-name))))))
+ (let* ((default (expand-file-name (buffer-name)))
+ (filename
+ (expand-file-name
+ (read-file-name
+ (format-prompt "File to save in"
+ (file-name-nondirectory default))
+ nil default))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name
of an
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a96c6c9..18330d8 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -85,8 +85,8 @@ the options \"-dilsb\".
While the option `find -ls' often produces unsorted output, the option
`find -exec ls -ld' maintains the sorting order only on short output,
-whereas `find -print | sort | xargs' produced sorted output even
-on the large number of files."
+whereas `find -print | sort | xargs' produces sorted output even
+on a large number of files."
:version "27.1" ; add choice of predefined set of options
:type `(choice
(cons :tag "find -ls"
@@ -164,7 +164,10 @@ The command run (after changing into DIR) is essentially
find . \\( ARGS \\) -ls
except that the car of the variable `find-ls-option' specifies what to
-use in place of \"-ls\" as the final argument."
+use in place of \"-ls\" as the final argument.
+
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find]."
(interactive (list (read-directory-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
'(find-args-history . 1))))
@@ -215,7 +218,6 @@ use in place of \"-ls\" as the final argument."
(car find-ls-option))))
;; Start the find process.
(shell-command (concat args "&") (current-buffer))
- ;; The next statement will bomb in classic dired (no optional arg allowed)
(dired-mode dir (cdr find-ls-option))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
@@ -247,8 +249,8 @@ use in place of \"-ls\" as the final argument."
(dired-insert-set-properties point (point)))
(setq buffer-read-only t)
(let ((proc (get-buffer-process (current-buffer))))
- (set-process-filter proc (function find-dired-filter))
- (set-process-sentinel proc (function find-dired-sentinel))
+ (set-process-filter proc #'find-dired-filter)
+ (set-process-sentinel proc #'find-dired-sentinel)
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) (point) (current-buffer)))
(setq mode-line-process '(":%s"))))
@@ -258,7 +260,7 @@ use in place of \"-ls\" as the final argument."
(interactive)
(let ((find (get-buffer-process (current-buffer))))
(and find (eq (process-status find) 'run)
- (eq (process-filter find) (function find-dired-filter))
+ (eq (process-filter find) #'find-dired-filter)
(condition-case nil
(delete-process find)
(error nil)))))
diff --git a/lisp/format.el b/lisp/format.el
index f3559ba..905ca2d 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -342,8 +342,8 @@ for identifying regular expressions at the beginning of the
region."
FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the
formats defined in `format-alist', or a list of such symbols."
(interactive
- (list (format-read (format "Translate buffer to format (default %s): "
- buffer-file-format))))
+ (list (format-read (format-prompt "Translate buffer to format"
+ buffer-file-format))))
(format-encode-region (point-min) (point-max) format))
(defun format-encode-region (beg end &optional format)
@@ -352,8 +352,8 @@ FORMAT defaults to `buffer-file-format'. It is a symbol
naming
one of the formats defined in `format-alist', or a list of such symbols."
(interactive
(list (region-beginning) (region-end)
- (format-read (format "Translate region to format (default %s): "
- buffer-file-format))))
+ (format-read (format-prompt "Translate region to format"
+ buffer-file-format))))
(if (null format) (setq format buffer-file-format))
(if (symbolp format) (setq format (list format)))
(save-excursion
diff --git a/lisp/frame.el b/lisp/frame.el
index 081d301..7751ae1 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -733,7 +733,7 @@ argument PARAMETERS specifies additional frame parameters."
(list
(let* ((default (cdr (assq 'name (frame-monitor-attributes)))))
(completing-read
- (format "Make frame on monitor (default %s): " default)
+ (format-prompt "Make frame on monitor" default)
(or (delq nil (mapcar (lambda (a)
(cdr (assq 'name a)))
(display-monitor-attributes-list)))
@@ -760,7 +760,7 @@ If DISPLAY is nil, that stands for the selected frame's
display."
(list
(let* ((default (frame-parameter nil 'display))
(display (completing-read
- (format "Close display (default %s): " default)
+ (format-prompt "Close display" default)
(delete-dups
(mapcar (lambda (frame)
(frame-parameter frame 'display))
@@ -1130,7 +1130,7 @@ If there is no frame by that name, signal an error."
(let* ((frame-names-alist (make-frame-names-alist))
(default (car (car frame-names-alist)))
(input (completing-read
- (format "Select Frame (default %s): " default)
+ (format-prompt "Select Frame" default)
frame-names-alist nil t nil 'frame-name-history)))
(if (= (length input) 0)
(list default)
@@ -1412,12 +1412,12 @@ as though the font-related attributes of the `default'
face had been
\"set in this session\", so that the font is applied to future frames."
(interactive
(let* ((completion-ignore-case t)
- (font (completing-read "Font name: "
+ (default (frame-parameter nil 'font))
+ (font (completing-read (format-prompt "Font name" default)
;; x-list-fonts will fail with an error
;; if this frame doesn't support fonts.
(x-list-fonts "*" nil (selected-frame))
- nil nil nil nil
- (frame-parameter nil 'font))))
+ nil nil nil nil default)))
(list font current-prefix-arg nil)))
(when (or (stringp font) (fontp font))
(let* ((this-frame (selected-frame))
@@ -1581,8 +1581,9 @@ When called interactively, prompt for the name of the
frame.
On text terminals, the frame name is displayed on the mode line.
On graphical displays, it is displayed on the frame's title bar."
(interactive
- (list (read-string "Frame name: " nil nil
- (cdr (assq 'name (frame-parameters))))))
+ (let ((default (cdr (assq 'name (frame-parameters)))))
+ (list (read-string (format-prompt "Frame name" default) nil nil
+ default))))
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 1b00bbb..7e96843 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -315,8 +315,7 @@ affect point."
"Load Gnus bookmarks from FILE (which must be in bookmark format)."
(interactive
(list (read-file-name
- (format "Load Gnus bookmarks from: (%s) "
- gnus-bookmark-default-file)
+ (format-prompt "Load Gnus bookmarks from" gnus-bookmark-default-file)
"~/" gnus-bookmark-default-file 'confirm)))
(setq file (expand-file-name file))
(if (file-readable-p file)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 7ca3bf1..c31d97d 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -93,6 +93,8 @@ it's not cached."
(autoload 'nnml-generate-nov-databases-directory "nnml")
(autoload 'nnvirtual-find-group-art "nnvirtual")
+(autoload 'nnselect-article-group "nnselect")
+(autoload 'nnselect-article-number "nnselect")
@@ -158,8 +160,12 @@ it's not cached."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(when (and number
@@ -232,8 +238,14 @@ it's not cached."
(let ((arts gnus-cache-removable-articles)
ga)
(while arts
- (when (setq ga (nnvirtual-find-group-art
- (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
+ (when (setq ga
+ (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (with-current-buffer gnus-summary-buffer
+ (let ((article (pop arts)))
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article))))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name gnus-newsgroup-name) (pop arts))))
(let ((gnus-cache-removable-articles (list (cdr ga)))
(gnus-newsgroup-name (car ga)))
(gnus-cache-possibly-remove-articles-1)))))
@@ -467,8 +479,12 @@ Returns the list of articles removed."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(setq file (gnus-cache-file-name group number))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index e40b2eb..3e23e26 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -414,8 +414,7 @@ When FULL is t, upload everything, not just a difference
from the last full."
(while (setq head (nnheader-parse-head))
(when gnus-alter-header-function
(funcall gnus-alter-header-function head))
- (push head headers))
- ))
+ (push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
(> (gnus-cloud-chunk-sequence (mail-header-subject h1))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index ad6e0e3..fcaa6d7 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2416,9 +2416,8 @@ the bug number, and browsing the URL must return mbox
output."
;; Pass DEF as the value of COLLECTION instead of DEF because:
;; a) null input should not cause DEF to be returned and
;; b) TAB and M-n still work this way.
- (or (completing-read-multiple
- (format "Bug IDs%s: " (if def (format " (default %s)" def) ""))
- (and def (list (format "%s" def))))
+ (or (completing-read-multiple (format-prompt "Bug IDs" def)
+ (and def (list (format "%s" def))))
def)))
(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
@@ -3186,23 +3185,26 @@ mail messages or news articles in files that have
numeric names."
(cons 'nnselect-args
(nnir-make-specs nnir-extra-parms specs)))))))))
-(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms
&optional specs)
- "Create an nnselect group based on a search. Prompt for a
-search query and determine the groups to search as follows: if
-called from the *Server* buffer search all groups belonging to
-the server on the current line; if called from the *Group* buffer
-search any marked groups, or the group on the current line, or
-all the groups under the current topic. Calling with a prefix-arg
-prompts for additional search-engine specific constraints. A
-non-nil `specs' arg must be an alist with `nnir-query-spec' and
-`nnir-group-spec' keys, and skips all prompting."
+(define-obsolete-function-alias 'gnus-group-make-nnir-group
+ 'gnus-group-read-ephemeral-search-group "28.1")
+
+(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional
specs)
+ "Create an nnselect group based on a search.
+Prompt for a search query and determine the groups to search as
+follows: if called from the *Server* buffer search all groups
+belonging to the server on the current line; if called from the
+*Group* buffer search any marked groups, or the group on the
+current line, or all the groups under the current topic. Calling
+with a prefix arg prompts for additional search-engine specific
+constraints. A non-nil SPECS arg must be an alist with
+`nnir-query-spec' and `nnir-group-spec' keys, and skips all
+prompting."
(interactive "P")
(gnus-group-read-ephemeral-group
(concat "nnselect-" (message-unique-id))
(list 'nnselect "nnselect")
nil
(cons (current-buffer) gnus-current-window-configuration)
- ; nil
nil nil
(list
(cons 'nnselect-specs
@@ -3744,9 +3746,8 @@ Uses the process/prefix convention."
(error "No group on the current line"))
(string-to-number
(let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
+ (format-prompt "Level" (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
(if (string-match "^\\s-*$" s)
(int-to-string (or (gnus-group-group-level)
gnus-level-default-subscribed))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 46b70ea..c5156a1 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1370,9 +1370,12 @@ If FORMAT, also format the current score file."
(setq
err
(cond
- ((if (member (downcase type) '("lines" "chars"))
- (not (numberp (car s)))
- (not (stringp (car s))))
+ ((cond ((member (downcase type) '("lines" "chars"))
+ (not (numberp (car s))))
+ ((string= (downcase type) "date")
+ (not (or (numberp (car s))
+ (stringp (car s)))))
+ (t (not (stringp (car s)))))
(format "Invalid match %s in %s" (car s) file))
((and (cadr s) (not (integerp (cadr s))))
(format "Non-integer score %s in %s" (cadr s) file))
@@ -1690,9 +1693,19 @@ score in `gnus-newsgroup-scored' by SCORE."
((eq type 'after)
(setq match-func 'string<
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '<)
+ (setq type 'after
+ match-func 'gnus-string>
+ match (gnus-time-iso8601
+ (time-add (current-time) (* 86400 (nth 0 kill))))))
((eq type 'before)
(setq match-func 'gnus-string>
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '>)
+ (setq type 'before
+ match-func 'gnus-string>
+ match (gnus-time-iso8601
+ (time-add (current-time) (* -86400 (nth 0 kill))))))
((eq type 'at)
(setq match-func 'string=
match (gnus-date-iso8601 (nth 0 kill))))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 8cb80b2..6beb543 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -35,7 +35,6 @@
(require 'gnus-cloud)
(autoload 'gnus-group-read-ephemeral-search-group "nnselect")
-;;(autoload 'gnus-group-make-permanent-search-group "nnselect")
(defcustom gnus-server-exit-hook nil
"Hook run when exiting the server buffer."
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index e4f05de..615f8df 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -72,7 +72,7 @@ uses considerably less memory."
(const :tag "Write directly to file" nil)))
(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
- "Your Gnus Emacs-Lisp startup file name.
+ "Your Gnus Emacs Lisp startup file name.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
:group 'gnus-start
:type 'file)
@@ -83,7 +83,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will
be read instead."
(directory-file-name installation-directory))
"site-lisp/gnus-init")
(error nil))
- "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+ "The site-wide Gnus Emacs Lisp startup file name, or nil if none.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
:group 'gnus-start
:type '(choice file (const nil)))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 8f37fc8..45397b5 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -87,6 +87,7 @@
(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
(autoload 'nnselect-article-rsv "nnselect" nil nil)
(autoload 'nnselect-article-group "nnselect" nil nil)
+(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
(defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it.
@@ -144,11 +145,14 @@ If t, fetch all the available old headers."
:type '(choice number
(sexp :menu-tag "other" t)))
+(define-obsolete-variable-alias 'gnus-refer-thread-use-nnir
+ 'gnus-refer-thread-use-search "28.1")
+
(defcustom gnus-refer-thread-use-search nil
- "Search an entire server when referring threads. A
-nil value will only search for thread-related articles in the
+ "Search an entire server when referring threads.
+A nil value will only search for thread-related articles in the
current group."
- :version "24.1"
+ :version "28.1"
:group 'gnus-thread
:type 'boolean)
@@ -1986,6 +1990,7 @@ increase the score of each group you read."
"\M-K" gnus-summary-edit-global-kill
;; "V" gnus-version
"\C-c\C-d" gnus-summary-describe-group
+ "\C-c\C-p" gnus-summary-make-group-from-search
"q" gnus-summary-exit
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
@@ -7117,6 +7122,21 @@ The prefix argument ALL means to select all articles."
(setq info (copy-sequence (gnus-get-info group))
info (delq (gnus-info-params info) info))))))))))
+(defun gnus-summary-make-group-from-search ()
+ "Make a persistent group from the current ephemeral search group."
+ (interactive)
+ (if (not (gnus-nnselect-group-p gnus-newsgroup-name))
+ (gnus-message 3 "%s is not a search group" gnus-newsgroup-name)
+ (let ((name (gnus-read-group "Group name: ")))
+ (with-current-buffer gnus-group-buffer
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list (cons 'nnselect-specs
+ (gnus-group-get-parameter gnus-newsgroup-name
+ 'nnselect-specs t))))))))
+
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
The dribble buffer will then be saved.
@@ -8984,16 +9004,15 @@ Return the number of articles fetched."
result))
(defun gnus-summary-refer-thread (&optional limit)
- "Fetch all articles in the current thread. For backends that
-know how to search for threads (currently only 'nnimap) a
-non-numeric prefix arg will search the entire
-server; without a prefix arg only the current group is
-searched. If the variable `gnus-refer-thread-use-search' is
-non-nil the prefix arg has the reverse meaning. If no
-backend-specific 'request-thread function is available fetch
-LIMIT (the numerical prefix) old headers. If LIMIT is
-non-numeric or nil fetch the number specified by the
-`gnus-refer-thread-limit' variable."
+ "Fetch all articles in the current thread.
+For backends that know how to search for threads (currently only
+`nnimap') a non-numeric prefix arg will search the entire server;
+without a prefix arg only the current group is searched. If the
+variable `gnus-refer-thread-use-search' is non-nil the prefix arg
+has the reverse meaning. If no backend-specific `request-thread'
+function is available fetch LIMIT (the numerical prefix) old
+headers. If LIMIT is non-numeric or nil fetch the number
+specified by the `gnus-refer-thread-limit' variable."
(interactive "P")
(let* ((header (gnus-summary-article-header))
(id (mail-header-id header))
@@ -9389,10 +9408,10 @@ default."
(cond ((= (length urls) 1)
(car urls))
((> (length urls) 1)
- (completing-read (format "URL to browse (default %s): "
- (gnus-shorten-url (car urls) 40))
- urls nil t nil nil
- (car urls)))))
+ (completing-read
+ (format-prompt "URL to browse"
+ (gnus-shorten-url (car urls) 40))
+ urls nil t nil nil (car urls)))))
(if target
(if external
(funcall browse-url-secondary-browser-function target)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index b7c0ff6..6216a9a 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3159,7 +3159,7 @@ that that variable is buffer-local to the summary
buffers."
(defun gnus-kill-ephemeral-group (group)
"Remove ephemeral GROUP from relevant structures."
(remhash group gnus-newsrc-hashtb)
- (setq gnus-newsrc-alist
+ (setq gnus-newsrc-alist
(delq (assoc group gnus-newsrc-alist)
gnus-newsrc-alist)))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 7f8ab5f..1bce6ca 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1364,10 +1364,7 @@ PROMPT overrides the default one used to ask user for a
file name."
(setq file
(read-file-name
(or prompt
- (format "Save MIME part to%s: "
- (if filename
- (format " (default %s)" filename)
- "")))
+ (format-prompt "Save MIME part to" filename))
(or directory mm-default-directory default-directory)
(expand-file-name
(or filename "")
@@ -1668,12 +1665,14 @@ If RECURSIVE, search recursively."
(let ((type (car ctl))
(subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
+ (smime-type (cdr (assq 'smime-type (mm-handle-type parts))))
protocol func functest)
(cond
((or (equal type "application/x-pkcs7-mime")
(equal type "application/pkcs7-mime"))
(with-temp-buffer
(when (and (cond
+ ((equal smime-type "signed-data") t)
((eq mm-decrypt-option 'never) nil)
((eq mm-decrypt-option 'always) t)
((eq mm-decrypt-option 'known) t)
@@ -1694,7 +1693,21 @@ If RECURSIVE, search recursively."
(unless (mail-fetch-field "content-type")
(goto-char (point-max))
(insert "Content-type: text/plain\n\n")))
- (setq parts (mm-dissect-buffer t)))))
+ (setq parts
+ (if (equal smime-type "signed-data")
+ (list (propertize
+ "multipart/signed"
+ 'protocol "application/pkcs7-signature"
+ 'gnus-info
+ (format
+ "%s:%s"
+ (get-text-property 0 'gnus-info
+ (car mm-security-handle))
+ (get-text-property 0 'gnus-details
+ (car mm-security-handle))))
+ (mm-dissect-buffer t)
+ parts)
+ (mm-dissect-buffer t))))))
((equal subtype "signed")
(unless (and (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index bd5960c..cb39ffe 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -597,8 +597,16 @@ If MODE is not set, try to find mode automatically."
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(goto-char (point-min))
- (let ((part (base64-decode-string (buffer-string))))
- (epg-verify-string (epg-make-context 'CMS) part))))
+ (let ((part (base64-decode-string (buffer-string)))
+ (context (epg-make-context 'CMS)))
+ (prog1
+ (epg-verify-string context part)
+ (let ((result (car (epg-context-result-for context 'verify))))
+ (mm-sec-status
+ 'gnus-info (epg-signature-status result)
+ 'gnus-details
+ (format "%s:%s" (epg-signature-validity result)
+ (epg-signature-key-id result))))))))
(with-temp-buffer
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 1a50697..67dc379 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -195,8 +195,8 @@ on your system, you could say something like:
(defsubst nnheader-head-make-header (number)
- "Using data of type 'head in the current buffer
- return a full mail header with article NUMBER."
+ "Return a full mail header with article NUMBER.
+Do this using data of type `head' in the current buffer."
(let ((p (point-min))
(cur (current-buffer))
in-reply-to chars lines end ref)
@@ -306,14 +306,13 @@ on your system, you could say something like:
out)))))
(defun nnheader-parse-head (&optional naked temp)
- "Parse data of type 'header in the current buffer and return a
- mail header, modifying the buffer contents in the process. The
- buffer is assumed to begin each header with an \"Article
- retrieved\" line with an article number; If NAKED is non-nil
- this line is assumed absent, and the buffer should contain a
- single header's worth of data. If TEMP is non-nil the data is
- first copied to a temporary buffer leaving the original buffer
- untouched."
+ "Parse data of type `header' in the current buffer and return a mail header.
+Modify the buffer contents in the process. The buffer is assumed
+to begin each header with an \"Article retrieved\" line with an
+article number; if NAKED is non-nil this line is assumed absent,
+and the buffer should contain a single header's worth of data.
+If TEMP is non-nil the data is first copied to a temporary buffer
+leaving the original buffer untouched."
(let ((cur (current-buffer))
(num 0)
(beg (point-min))
@@ -326,22 +325,22 @@ on your system, you could say something like:
(setq num (read cur)
beg (point)
end (if (search-forward "\n.\n" nil t)
- (goto-char (- (point) 2))
+ (goto-char (- (point) 2))
(point)))))
- ;; When TEMP copy the data to a temporary buffer
+ ;; When TEMP copy the data to a temporary buffer.
(if temp
(progn
(set-buffer (setq buf (generate-new-buffer " *nnheader-temp*")))
(insert-buffer-substring cur beg end))
- ;; Otherwise just narrow to the data
+ ;; Otherwise just narrow to the data.
(narrow-to-region beg end))
(let ((case-fold-search t)
(buffer-read-only nil)
header)
(nnheader-remove-cr-followed-by-lf)
(ietf-drums-unfold-fws)
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (subst-char-in-region (point-min) (point-max) ?\r ? t)
+ (subst-char-in-region (point-min) (point-max) ?\t ?\s t)
+ (subst-char-in-region (point-min) (point-max) ?\r ?\s t)
(goto-char (point-min))
(insert "\n")
(setq header (nnheader-head-make-header num))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 2ec39cf..c46903a 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -55,7 +55,7 @@
;; 'nnir-group-spec is a list with the specification of the
;; groups/servers to search. The format of the 'nnir-group-spec is
;; (("server1" ("group11" "group12")) ("server2" ("group21"
-;; "group22"))). If any of the group lists is absent then all groups
+;; "group22"))). If any of the group lists is absent then all groups
;; on that server are searched.
;; The output of `nnir-run-query' is a vector, each element of which
@@ -211,6 +211,26 @@ By default this is the name of an email header field.")
"Search groups in Gnus with assorted search engines."
:group 'gnus)
+(make-obsolete-variable 'nnir-summary-line-format "The formating
+specs previously unique to this variable may now be set in
+'gnus-summary-line-format." "28.1")
+
+(defcustom nnir-summary-line-format nil
+ "The format specification of the lines in an nnir summary buffer.
+
+All the items from `gnus-summary-line-format' are available, along
+with three items unique to nnir summary buffers:
+
+%Z Search retrieval score value (integer)
+%G Article original full group name (string)
+%g Article original short group name (string)
+
+If nil this will use `gnus-summary-line-format'."
+ :version "24.1"
+ :type '(choice (const :tag "gnus-summary-line-format" nil) string)
+ :group 'nnir)
+
+
(defcustom nnir-ignored-newsgroups ""
"Newsgroups to skip when searching.
Any newsgroup in the active file matching this regexp will be
@@ -335,7 +355,7 @@ Instead, use this:
(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from HyREX file names to get group names.
-Restulting names have '/' in place of '.'.
+Resulting names have '/' in place of '.'.
For example, suppose that HyREX returns file names such as
\"/home/john/Mail/mail/misc/42\". For this example, use the following
@@ -1094,7 +1114,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(nnir-artitem-rsv y)))))))))
(defun nnir-run-notmuch (query server &optional groups)
- "Run QUERY with GROUPS from SERVER against notmuch.
+ "Run QUERY with GROUPS from SERVER against notmuch.
Returns a vector of (group name, file name) pairs (also vectors,
actually). If GROUPS is a list of group names, use them to
construct path: search terms (see the variable
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 460bc63..4916286 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -18,16 +18,16 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; This is a "virtual" backend that allows an aribtrary list of
-;; articles to be treated as a gnus group. An nnselect group uses an
-;; nnselect-spec group parameter to specify this list of
-;; articles. nnselect-spec is an alist with two keys:
-;; nnselect-function, whose value should be a function that returns
-;; the list of articles, and nnselect-args. The function will be
+;; This is a "virtual" backend that allows an arbitrary list of
+;; articles to be treated as a Gnus group. An nnselect group uses an
+;; `nnselect-spec' group parameter to specify this list of
+;; articles. `nnselect-spec' is an alist with two keys:
+;; `nnselect-function', whose value should be a function that returns
+;; the list of articles, and `nnselect-args'. The function will be
;; applied to the arguments to generate the list of articles. The
;; return value should be a vector, each element of which should in
;; turn be a vector of three elements: a real prefixed group name, an
@@ -238,6 +238,9 @@ as `(keyfunc member)' and the corresponding element is just
"Virtual groups in Gnus with arbitrary selection methods."
:group 'gnus)
+(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function
+ 'nnselect-retrieve-headers-override-function "28.1")
+
(defcustom nnselect-retrieve-headers-override-function nil
"A function that retrieves article headers for ARTICLES from GROUP.
The retrieved headers should populate the `nntp-server-buffer'.
@@ -245,8 +248,7 @@ Returns either the retrieved header format 'nov or 'headers.
If this variable is nil, or if the provided function returns nil,
`gnus-retrieve-headers' will be called instead."
- :version "24.1" :type '(function) :group 'nnselect)
-
+ :version "28.1" :type '(function) :group 'nnselect)
;; Gnus backend interface functions.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index baf0fef..fe0af3c 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -929,10 +929,7 @@ it is displayed along with the global value."
(orig-buffer (current-buffer))
val)
(setq val (completing-read
- (if (symbolp v)
- (format
- "Describe variable (default %s): " v)
- "Describe variable: ")
+ (format-prompt "Describe variable" (and (symbolp v) v))
#'help--symbol-completion-table
(lambda (vv)
;; In case the variable only exists in the buffer
@@ -1429,10 +1426,8 @@ current buffer and the selected frame, respectively."
(v-or-f (if found v-or-f (function-called-at-point)))
(found (or found v-or-f))
(enable-recursive-minibuffers t)
- (val (completing-read (if found
- (format
- "Describe symbol (default %s): " v-or-f)
- "Describe symbol: ")
+ (val (completing-read (format-prompt "Describe symbol"
+ (and found v-or-f))
#'help--symbol-completion-table
(lambda (vv)
(cl-some (lambda (x) (funcall (nth 1 x) vv))
@@ -1608,7 +1603,7 @@ keymap value."
(interactive
(let* ((km (help-fns--most-relevant-active-keymap))
(val (completing-read
- (format "Keymap (default %s): " km)
+ (format-prompt "Keymap" km)
obarray
(lambda (m) (and (boundp m) (keymapp (symbol-value m))))
t nil 'keymap-name-history
@@ -1825,8 +1820,9 @@ one of them returns non-nil."
;;;###autoload
(defun doc-file-to-man (file)
"Produce an nroff buffer containing the doc-strings from the DOC file."
- (interactive (list (read-file-name "Name of DOC file: " doc-directory
- internal-doc-file-name t)))
+ (interactive (list (read-file-name (format-prompt "Name of DOC file"
+ internal-doc-file-name)
+ doc-directory internal-doc-file-name t)))
(or (file-readable-p file)
(error "Cannot read file `%s'" file))
(pop-to-buffer (generate-new-buffer "*man-doc*"))
@@ -1855,8 +1851,9 @@ one of them returns non-nil."
;;;###autoload
(defun doc-file-to-info (file)
"Produce a texinfo buffer with sorted doc-strings from the DOC file."
- (interactive (list (read-file-name "Name of DOC file: " doc-directory
- internal-doc-file-name t)))
+ (interactive (list (read-file-name (format-prompt "Name of DOC file"
+ internal-doc-file-name)
+ doc-directory internal-doc-file-name t)))
(or (file-readable-p file)
(error "Cannot read file `%s'" file))
(let ((i 0) type name doc alist)
diff --git a/lisp/help.el b/lisp/help.el
index 897ab4a..928a376 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -178,7 +178,7 @@ Do not call this in the scope of `with-help-window'."
(if (same-window-p (buffer-name standard-output))
;; Say how to scroll this window.
(substitute-command-keys
- "\\[scroll-up] to scroll the help.")
+ "\\[scroll-up-command] to scroll the help.")
;; Say how to scroll some other window.
(substitute-command-keys
"\\[scroll-other-window] to scroll the help."))))))))
@@ -364,7 +364,7 @@ With argument, display info only for the selected version."
(sort (delete-dups res) #'string>)))
(current (car all-versions)))
(setq version (completing-read
- (format "Read NEWS for the version (default %s): " current)
+ (format-prompt "Read NEWS for the version" current)
all-versions nil nil nil nil current))
(if (integerp (string-to-number version))
(setq version (string-to-number version))
@@ -533,12 +533,9 @@ If INSERT (the prefix arg) is non-nil, insert the message
in the buffer."
(let ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if fn
- (format "Where is command (default %s): " fn)
- "Where is command: ")
- obarray 'commandp t nil nil
- (and fn (symbol-name fn))))
+ (setq val (completing-read (format-prompt "Where is command" fn)
+ obarray 'commandp t nil nil
+ (and fn (symbol-name fn))))
(list (unless (equal val "") (intern val))
current-prefix-arg)))
(unless definition (error "No command"))
@@ -1134,7 +1131,7 @@ window."
".")
((eq scroll 'other)
", \\[scroll-other-window] to scroll help.")
- (scroll ", \\[scroll-up] to scroll help."))))
+ (scroll ", \\[scroll-up-command] to scroll help."))))
(message "%s"
(substitute-command-keys (concat quit-part scroll-part)))))
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 0ffe77d..0fe651a 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -657,10 +657,7 @@ then remove all hi-lock highlighting."
(car pattern)))
hi-lock-interactive-patterns))))
(list
- (completing-read (if (null defaults)
- "Regexp to unhighlight: "
- (format "Regexp to unhighlight (default %s): "
- (car defaults)))
+ (completing-read (format-prompt "Regexp to unhighlight" (car defaults))
(mapcar (lambda (pattern)
(cons (or (car (rassq pattern
hi-lock-interactive-lighters))
(car pattern))
@@ -747,8 +744,7 @@ with completion and history."
(if (and hi-lock-auto-select-face (not current-prefix-arg))
(setq face (or (pop hi-lock--unused-faces) (car defaults)))
(setq face (completing-read
- (format "Highlight using face (default %s): "
- (car defaults))
+ (format-prompt "Highlight using face" (car defaults))
obarray 'facep t nil 'face-name-history defaults))
;; Update list of un-used faces.
(setq hi-lock--unused-faces (remove face hi-lock--unused-faces))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index c9ca1f8..80c5b07 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1234,14 +1234,12 @@ Called interactively, accept a comma separated list of
mode names."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- obarray
- (lambda (e)
- (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
- t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ obarray
+ (lambda (e)
+ (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
+ t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1259,11 +1257,9 @@ currently used by buffers."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- (ibuffer-list-buffer-modes) nil t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ (ibuffer-list-buffer-modes) nil t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1881,9 +1877,7 @@ Otherwise buffers whose name matches an element of
'major-mode buf)))))
(list (intern
(completing-read
- (if default
- (format "Mark by major mode (default %s): " default)
- "Mark by major mode: ")
+ (format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index ba266cf..4e54680 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -77,7 +77,7 @@ selection process starts again from the user's $HOME.")
(defcustom icomplete-show-matches-on-no-input nil
"When non-nil, show completions when first prompting for input.
This also means that if you traverse the list of completions with
-commands like `C-.' and just hit `C-j' (enter) without typing any
+commands like `C-.' and just hit RET without typing any
characters, the match under point will be chosen instead of the
default."
:type 'boolean
@@ -157,12 +157,22 @@ icompletion is occurring."
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map [?\M-\t] 'icomplete-force-complete)
+ (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret)
(define-key map [?\C-j] 'icomplete-force-complete-and-exit)
(define-key map [?\C-.] 'icomplete-forward-completions)
(define-key map [?\C-,] 'icomplete-backward-completions)
map)
"Keymap used by `icomplete-mode' in the minibuffer.")
+(defun icomplete-ret ()
+ "Exit minibuffer for icomplete."
+ (interactive)
+ (if (and icomplete-show-matches-on-no-input
+ (car completion-all-sorted-completions)
+ (eql (icomplete--field-end) (icomplete--field-beg)))
+ (icomplete-force-complete-and-exit)
+ (minibuffer-complete-and-exit)))
+
(defun icomplete-force-complete-and-exit ()
"Complete the minibuffer with the longest possible match and exit.
Use the first of the matches if there are any displayed, and use
@@ -469,38 +479,80 @@ Usually run by inclusion in `minibuffer-setup-hook'."
with beg = (icomplete--field-beg)
with end = (icomplete--field-end)
with all = (completion-all-sorted-completions beg end)
+ ;; Icomplete mode re-sorts candidates, bubbling the default to
+ ;; top if it's found somewhere down the list. This loop's
+ ;; iteration variable, `fn' iterates through these "bubble up
+ ;; predicates" which may vary depending on specific
+ ;; `completing-read' invocations, described below:
for fn in (cond ((and minibuffer-default
(stringp minibuffer-default) ; bug#38992
(= (icomplete--field-end) (icomplete--field-beg)))
- ;; When we have a non-nil string default and
- ;; no input whatsoever: we want to make sure
- ;; that default is bubbled to the top so that
- ;; `icomplete-force-complete-and-exit' will
- ;; select it (do that even if the match
- ;; doesn't match the completion perfectly.
- `(,(lambda (comp)
+ ;; Here, we have a non-nil string default and
+ ;; no input whatsoever. We want to make sure
+ ;; that the default is bubbled to the top so
+ ;; that `icomplete-force-complete-and-exit'
+ ;; will select it. We want to do that even if
+ ;; the match doesn't match the completion
+ ;; perfectly.
+ ;;
+ `(;; The first predicate ensures that:
+ ;;
+ ;; (completing-read "thing? " '("foo" "bar")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Has "bar" at the top, so RET will select
+ ;; it, as desired.
+ ,(lambda (comp)
(equal minibuffer-default comp))
+ ;; Why do we need this second predicate?
+ ;; Because that'll make things like M-x man
+ ;; RET RET, when invoked with point on the
+ ;; "bar" word, behave correctly. There, the
+ ;; default doesn't quite match any
+ ;; candidate. So:
+ ;;
+ ;; (completing-read "Man entry? " '("foo(1)"
"bar(1)")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Will place "bar(1)" on top, and RET will
+ ;; select it -- again, as desired.
+ ;;
+ ;; FIXME: it's arguable that this second
+ ;; behaviour should be a property of the
+ ;; completion table and not the completion
+ ;; frontend such as we have done
+ ;; here. However, it seems generically
+ ;; useful for a very broad spectrum of
+ ;; cases.
,(lambda (comp)
(string-prefix-p minibuffer-default comp))))
((and fido-mode
(not minibuffer-default)
(eq (icomplete--category) 'file))
- ;; `fido-mode' has some extra file-sorting
- ;; semantics even if there isn't a default,
- ;; which is to bubble "./" to the top if it
- ;; exists. This makes M-x dired RET RET go to
- ;; the directory of current file, which is
- ;; what vanilla Emacs and `ido-mode' both do.
+ ;; When there isn't a default, `fido-mode'
+ ;; specifically also has some extra
+ ;; file-sorting semantics inherited from Ido.
+ ;; Those make the directory "./" bubble to the
+ ;; top (if it exists). This makes M-x dired
+ ;; RET RET go to the directory of current
+ ;; file, which is non-Icomplete vanilla Emacs
+ ;; and `ido-mode' both do.
`(,(lambda (comp)
(string= "./" comp)))))
- thereis (cl-loop
- for l on all
- while (consp (cdr l))
- for comp = (cadr l)
- when (funcall fn comp)
- do (setf (cdr l) (cddr l))
- and return
- (completion--cache-all-sorted-completions beg end (cons comp
all)))
+ ;; After we have setup the predicates, look for a completion
+ ;; matching one of them and bubble up it, destructively on
+ ;; `completion-all-sorted-completions' (unless that completion
+ ;; happens to be already on top).
+ thereis (or
+ (and (funcall fn (car all)) all)
+ (cl-loop
+ for l on all
+ while (consp (cdr l))
+ for comp = (cadr l)
+ when (funcall fn comp)
+ do (setf (cdr l) (cddr l))
+ and return
+ (completion--cache-all-sorted-completions beg end (cons comp
all))))
finally return all)))
@@ -713,10 +765,7 @@ matches exist."
(push comp prospects)
(setq limit t))))
(setq prospects (nreverse prospects))
- ;; Return the first match if the user hits enter.
- (when icomplete-show-matches-on-no-input
- (setq-local completion-content-when-empty (car prospects)))
- ;; Decorate first of the prospects.
+ ;; Decorate first of the prospects.
(when prospects
(let ((first (copy-sequence (pop prospects))))
(put-text-property 0 (length first)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 3a16dcb..8fdacb0 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -765,10 +765,13 @@ Return one of the entries in index-alist or nil."
index-alist))))
(when (stringp name)
(setq name (or (imenu-find-default name prepared-index-alist) name)))
- (cond (prompt)
- ((and name (imenu--in-alist name prepared-index-alist))
- (setq prompt (format "Index item (default %s): " name)))
- (t (setq prompt "Index item: ")))
+ (unless prompt
+ (setq prompt (format-prompt
+ "Index item"
+ (and name
+ (imenu--in-alist name prepared-index-alist)
+ ;; Default to `name' if it's in the alist.
+ name))))
(let ((minibuffer-setup-hook minibuffer-setup-hook))
;; Display the completion buffer.
(if (not imenu-eager-completion-buffer)
diff --git a/lisp/indent.el b/lisp/indent.el
index 9f32ced..0a0dd99 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -53,16 +53,7 @@ If `complete', TAB first tries to indent the current line,
and if the line
was already indented, then try to complete the thing at point.
Some programming language modes have their own variable to control this,
-e.g., `c-tab-always-indent', and do not respect this variable.
-
-If you want the TAB key to always insert a literal TAB character,
-this can't be controlled by setting this variable. Instead you
-could say something like:
-
-\(setq overriding-terminal-local-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\t] 'self-insert-command)
- map))"
+e.g., `c-tab-always-indent', and do not respect this variable."
:group 'indent
:type '(choice
(const :tag "Always indent" t)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 4e379ca..bcc2930 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -297,9 +297,7 @@ If optional argument QUERY is non-nil, query for the help
mode."
(completion-ignore-case (info-lookup->ignore-case topic mode))
(enable-recursive-minibuffers t)
(value (completing-read
- (if default
- (format "Describe %s (default %s): " topic default)
- (format "Describe %s: " topic))
+ (format-prompt "Describe %s" default topic)
completions nil nil nil 'info-lookup-history default)))
(list (if (equal value "") default value) mode)))
@@ -557,7 +555,7 @@ Return nil if there is nothing appropriate in the buffer
near point."
(info-lookup->regexp topic mode)))
(start (point)) end regexp subexp result)
(save-excursion
- (if (symbolp rule)
+ (if (functionp rule)
(setq result (funcall rule))
(if (consp rule)
(setq regexp (car rule)
@@ -610,6 +608,7 @@ Return nil if there is nothing appropriate in the buffer
near point."
(defun info-lookup-guess-custom-symbol ()
"Get symbol at point in custom buffers."
+ (declare (obsolete nil "28.1"))
(condition-case nil
(save-excursion
(let ((case-fold-search t)
@@ -1065,7 +1064,9 @@ Return nil if there is nothing appropriate in the buffer
near point."
:mode 'Custom-mode
:ignore-case t
:regexp "[^][()`'‘’,:\" \t\n]+"
- :parse-rule 'info-lookup-guess-custom-symbol
+ :parse-rule (lambda ()
+ (when-let ((symbol (get-text-property (point) 'custom-data)))
+ (symbol-name symbol)))
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
diff --git a/lisp/info.el b/lisp/info.el
index ab678c2..dc1102a 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1995,12 +1995,9 @@ the Top node in FILENAME."
"Search for REGEXP, starting from point, and select node it's found in.
If DIRECTION is `backward', search in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(deactivate-mark)
(when (equal regexp "")
@@ -2124,12 +2121,9 @@ If DIRECTION is `backward', search in the reverse
direction."
(defun Info-search-backward (regexp &optional bound noerror count)
"Search for REGEXP in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s backward (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s backward: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s backward" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(Info-search regexp bound noerror count 'backward))
@@ -2816,10 +2810,7 @@ new buffer."
(while (null item)
(setq item (let ((completion-ignore-case t)
(Info-complete-menu-buffer (current-buffer)))
- (completing-read (if default
- (format "Menu item (default %s): "
- default)
- "Menu item: ")
+ (completing-read (format-prompt "Menu item" default)
#'Info-complete-menu-item nil t nil nil
default))))
(list item current-prefix-arg))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 75d1c61..ccc8ac9 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -325,9 +325,7 @@ wrong, use this command again to toggle back to the right
mode."
'undecided))
buffer-file-coding-system)))
(list (read-coding-system
- (if default
- (format "Coding system for following command (default %s): "
default)
- "Coding system for following command: ")
+ (format-prompt "Coding system for following command" default)
default))))
(prefix-command-preserve-state)
(setq mule-cmds--prefixed-command-next-coding-system coding-system)
@@ -613,9 +611,8 @@ When called from a program, the value is the position of
the unencodable
character found, or nil if all characters are encodable."
(interactive
(list (let ((default (or buffer-file-coding-system 'us-ascii)))
- (read-coding-system
- (format "Coding-system (default %s): " default)
- default))))
+ (read-coding-system (format-prompt "Coding-system" default)
+ default))))
(let ((pos (unencodable-char-position (point) (point-max) coding-system)))
(if pos
(goto-char (1+ pos))
@@ -804,9 +801,8 @@ or specify any other coding system (and risk losing\n\
;; Read a coding system.
(setq coding-system
- (read-coding-system
- (format "Select coding system (default %s): " default)
- default))
+ (read-coding-system (format-prompt "Select coding system" default)
+ default))
(setq last-coding-system-specified coding-system))
(kill-buffer "*Warning*")
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 958fc0d..3edea7e 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1248,7 +1248,7 @@ Internal use only.")
(concat "\\(?:" completion-pcm--delim-wild-regex
"\\|\\([[:alpha:]]\\)[[:digit:]]\\)"))
(cs (completing-read
- (format "Coding system for saving file (default %s): " default)
+ (format-prompt "Coding system for saving file" default)
combined-table
nil t nil 'coding-system-history
(if default (symbol-name default)))))
@@ -1351,8 +1351,7 @@ graphical terminals."
default-terminal-coding-system)
default-terminal-coding-system)))
(read-coding-system
- (format "Coding system for terminal display (default %s): "
- default)
+ (format-prompt "Coding system for terminal display" default)
default))))
(if (and (not coding-system)
(not (terminal-coding-system)))
@@ -1385,8 +1384,7 @@ graphical terminals."
(default (if (eq (coding-system-type coding) 'raw-text)
default-keyboard-coding-system)))
(read-coding-system
- (format "Coding system for keyboard input (default %s): "
- default)
+ (format-prompt "Coding system for keyboard input" default)
default))))
(let ((coding-type (coding-system-type coding-system))
(saved-meta-mode
@@ -1481,10 +1479,8 @@ the text is encoded or decoded by CODING-SYSTEM."
This setting is effective for the next communication only."
(interactive
(list (read-coding-system
- (if last-next-selection-coding-system
- (format "Coding system for the next selection (default %S): "
- last-next-selection-coding-system)
- "Coding system for the next selection: ")
+ (format-prompt "Coding system for the next selection"
+ last-next-selection-coding-system)
last-next-selection-coding-system)))
(if coding-system
(setq last-next-selection-coding-system coding-system)
@@ -2171,8 +2167,7 @@ Part of the job of this function is setting
`buffer-undo-list' appropriately."
(read-coding-system "Text was really in: ")
(let ((coding (or buffer-file-coding-system last-coding-system-used)))
(read-coding-system
- (concat "But was interpreted as"
- (if coding (format " (default %S): " coding) ": "))
+ (format-prompt "But was interpreted as" coding)
coding))))
(or (and new-coding coding)
(error "Coding system not specified"))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 9ab9e3b..37fcda7 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -300,9 +300,8 @@ The functions come in the following groups.
Store the name in the parameter-variable DEFAULT-NAME-VAR.
PROMPT is a string to be shown when the user is asked for a name."
(let ((encoding
- (completing-read
- (format "%s (default %s): " prompt (symbol-value default-name-var))
- ogonek-name-encoding-alist nil t)))
+ (completing-read (format-prompt prompt (symbol-value default-name-var))
+ ogonek-name-encoding-alist nil t)))
;; change the default name to the one just read, and
;; return the new default as the name you read
(set default-name-var
@@ -314,8 +313,7 @@ The result is stored in the variable DEFAULT-PREFIX-VAR.
PROMPT is a string to be shown when the user is asked for a new prefix."
(let ((prefix-string
(read-string
- (format "%s (default %s): " prompt
- (char-to-string (eval default-prefix-var))))))
+ (format-prompt prompt (char-to-string (eval default-prefix-var))))))
(if (> (length prefix-string) 1)
(error "! Only one character expected")
;; set the default prefix character to the one just read
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 81e83d7..7fb1d8a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2337,7 +2337,7 @@ characters in that string."
(with-isearch-suspended
(setq regexp-collect
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
regexp-collect))
;; Otherwise normal occur takes numerical prefix argument.
diff --git a/lisp/locate.el b/lisp/locate.el
index 9f40271..bc78e06 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -267,9 +267,7 @@ that is, with a prefix arg, you get the default behavior."
(let* ((default (locate-word-at-point))
(input
(read-from-minibuffer
- (if (> (length default) 0)
- (format "Locate (default %s): " default)
- (format "Locate: "))
+ (format-prompt "Locate" default)
nil nil nil 'locate-history-list default t)))
(and (equal input "") default
(setq input default))
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 6b9e1db..db85b64 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -305,30 +305,7 @@ usually do not have translators for other
languages.\n\n")))
(let ((txt (delete-and-extract-region (1+ user-point) (point))))
(insert (propertize "\n" 'display txt)))
- (insert "\nIn " (emacs-version))
- (if emacs-build-system
- (insert " built on " emacs-build-system))
- (insert "\n")
-
- (if (stringp emacs-repository-version)
- (insert "Repository revision: " emacs-repository-version "\n"))
- (if (stringp emacs-repository-branch)
- (insert "Repository branch: " emacs-repository-branch "\n"))
- (if (fboundp 'x-server-vendor)
- (condition-case nil
- ;; This is used not only for X11 but also W32 and others.
- (insert "Windowing system distributor '" (x-server-vendor)
- "', version "
- (mapconcat 'number-to-string (x-server-version) ".") "\n")
- (error t)))
- (let ((os (ignore-errors (report-emacs-bug--os-description))))
- (if (stringp os)
- (insert "System Description: " os "\n\n")))
- (when (and system-configuration-options
- (not (equal system-configuration-options "")))
- (insert "Configured using:\n 'configure "
- system-configuration-options "'\n\n")
- (fill-region (line-beginning-position -1) (point)))
+ (emacs-bug--system-description)
(insert "Configured features:\n" system-configuration-features "\n\n")
(fill-region (line-beginning-position -1) (point))
(insert "Important settings:\n")
@@ -409,6 +386,32 @@ usually do not have translators for other
languages.\n\n")))
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
+(defun emacs-bug--system-description ()
+ (insert "\nIn " (emacs-version))
+ (if emacs-build-system
+ (insert " built on " emacs-build-system))
+ (insert "\n")
+
+ (if (stringp emacs-repository-version)
+ (insert "Repository revision: " emacs-repository-version "\n"))
+ (if (stringp emacs-repository-branch)
+ (insert "Repository branch: " emacs-repository-branch "\n"))
+ (if (fboundp 'x-server-vendor)
+ (condition-case nil
+ ;; This is used not only for X11 but also W32 and others.
+ (insert "Windowing system distributor '" (x-server-vendor)
+ "', version "
+ (mapconcat 'number-to-string (x-server-version) ".") "\n")
+ (error t)))
+ (let ((os (ignore-errors (report-emacs-bug--os-description))))
+ (if (stringp os)
+ (insert "System Description: " os "\n\n")))
+ (when (and system-configuration-options
+ (not (equal system-configuration-options "")))
+ (insert "Configured using:\n 'configure "
+ system-configuration-options "'\n\n")
+ (fill-region (line-beginning-position -1) (point))))
+
(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
(defun report-emacs-bug-hook ()
@@ -475,6 +478,46 @@ and send the mail again%s."
(when (get-buffer-window help)
(quit-window nil (get-buffer-window help))))))
+;;;###autoload
+(defun submit-emacs-patch (subject file)
+ "Send an Emacs patch to the Emacs maintainers.
+Interactively, you will be prompted for SUBJECT and a patch FILE
+name (which will be attached to the mail). You will end up in a
+Message buffer where you can explain more about the patch."
+ (interactive "sThis patch is about: \nfPatch file name: ")
+ (switch-to-buffer "*Patch Help*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "Thank you for considering submitting a patch to the Emacs
project.\n\n"
+ "Please describe what the patch fixes (or, if it's a new feature,
what it\n"
+ "implements) in the mail buffer below. When done, use the `C-c
C-c' command\n"
+ "to send the patch as an email to the Emacs issue tracker.\n\n"
+ "If this is the first time you've submitted an Emacs patch,
please\n"
+ "read the ")
+ (insert-text-button
+ "CONTRIBUTE"
+ 'action (lambda (_)
+ (view-buffer
+ (find-file-noselect
+ (expand-file-name "CONTRIBUTE" installation-directory)))))
+ (insert " file first.\n")
+ (goto-char (point-min))
+ (view-mode 1)
+ (button-mode 1))
+ (message-mail-other-window report-emacs-bug-address subject)
+ (insert "\n\n\n")
+ (emacs-bug--system-description)
+ (mml-attach-file file "text/patch" nil "attachment")
+ (message-add-header "X-Debbugs-Tags: patch")
+ (message-goto-body)
+ (message "Write a description of the patch and use `C-c C-c' to send it")
+ (message-add-action
+ (lambda ()
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Patch Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
+ 'send))
(provide 'emacsbug)
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index a6a6068..09afad7 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -534,8 +534,7 @@ of a mail alias. The value is set up, buffer-local, when
first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read additional aliases from file (default %s): "
- def)
+ (format-prompt "Read additional aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
@@ -548,7 +547,7 @@ of a mail alias. The value is set up, buffer-local, when
first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read mail aliases from file (default %s): " def)
+ (format-prompt "Read mail aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 8e7aaf9..1f68873 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -255,9 +255,9 @@ removed from alias expansions."
By default, this is the file specified by `mail-personal-alias-file'."
(interactive
(list
- (read-file-name (format "Read mail alias file (default %s): "
- mail-personal-alias-file)
- nil mail-personal-alias-file t)))
+ (read-file-name
+ (format-prompt "Read mail alias file" mail-personal-alias-file)
+ nil mail-personal-alias-file t)))
(setq file (expand-file-name (or file mail-personal-alias-file)))
;; In case mail-aliases is t, make sure define-mail-alias
;; does not recursively call build-mail-aliases.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index f14025a..8bcb9af 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -39,6 +39,7 @@
(require 'mail-utils)
(require 'rfc2047)
+(require 'auth-source)
(require 'rmail-loaddefs)
@@ -1884,7 +1885,8 @@ interactively."
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
(setq supplied-password (rmail-get-remote-password
- (string-match "^imaps?" proto))))
+ (string-match "^imaps?" proto)
+ user host)))
;; FIXME
;; The password is embedded. Strip it out since movemail
;; does not really like it, in spite of the movemail spec.
@@ -1904,14 +1906,12 @@ interactively."
((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
(let (got-password supplied-password
- ;; (proto "pop")
- ;; (user (match-string 1 file))
- ;; (host (match-string 3 file))
- )
+ (user (match-string 1 file))
+ (host (match-string 3 file)))
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
- (setq supplied-password (rmail-get-remote-password nil)))
+ (setq supplied-password (rmail-get-remote-password nil user host)))
(list file "pop" supplied-password got-password)))
@@ -4461,15 +4461,30 @@ TEXT and INDENT are not used."
(setq rmail-remote-password nil)
(setq rmail-encoded-remote-password nil)))
-(defun rmail-get-remote-password (imap)
- "Get the password for retrieving mail from a POP or IMAP server. If none
-has been set, then prompt the user for one."
+(defun rmail-get-remote-password (imap user host)
+ "Get the password for retrieving mail from a POP or IMAP server.
+If none has been set, the password is found via auth-source. If
+you use ~/.authinfo as your auth-source backend, then put
+something like the following in that file:
+
+machine mymachine login myloginname password mypassword
+
+If auth-source search yields no result, prompt the user for the
+password."
(when (not rmail-encoded-remote-password)
(if (not rmail-remote-password)
- (setq rmail-remote-password
- (read-passwd (if imap
- "IMAP password: "
- "POP password: "))))
+ (setq rmail-remote-password
+ (let ((found (nth 0 (auth-source-search
+ :max 1 :user user :host host
+ :require '(:secret)))))
+ (if found
+ (let ((secret (plist-get found :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))
+ (read-passwd (if imap
+ "IMAP password: "
+ "POP password: "))))))
(rmail-set-remote-password rmail-remote-password)
(setq rmail-remote-password nil))
(rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 29c6dcf..0b9af82 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -269,7 +269,7 @@ TRUNCATED is non-nil if the text of this entity was
truncated."
(unless (y-or-n-p "This entity is truncated; save anyway? ")
(error "Aborted")))
(setq filename (expand-file-name
- (read-file-name (format "Save as (default: %s): " filename)
+ (read-file-name (format-prompt "Save as" filename)
directory
(expand-file-name filename directory))
directory))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 65d598c..dd6eecb 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -529,7 +529,7 @@ This also saves the value of `send-mail-function' via
Customize."
(display-buffer (current-buffer))
(let ((completion-ignore-case t))
(completing-read
- (format "Send mail via (default %s): " (caar options))
+ (format-prompt "Send mail via" (caar options))
options nil 'require-match nil nil (car options))))))
;; Return the choice.
(cdr (assoc-string choice options t))))
diff --git a/lisp/man.el b/lisp/man.el
index da8a15f..1a82b12 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1014,10 +1014,9 @@ to auto-complete your input based on the installed
manual pages."
(completion-ignore-case t)
Man-completion-cache ;Don't cache across calls.
(input (completing-read
- (format "Manual entry%s"
- (if (string= default-entry "")
- ": "
- (format " (default %s): " default-entry)))
+ (format-prompt "Manual entry"
+ (and (not (equal default-entry ""))
+ default-entry))
'Man-completion-table
nil nil nil 'Man-topic-history default-entry)))
(if (string= input "")
@@ -1542,8 +1541,8 @@ The following man commands are available in the buffer.
Try
\\[man] Prompt to retrieve a new manpage.
\\[Man-follow-manual-reference] Retrieve reference in SEE ALSO section.
-\\[Man-next-manpage] Jump to next manpage in circular list.
-\\[Man-previous-manpage] Jump to previous manpage in circular list.
+\\[Man-next-manpage] Jump to next manpage in circular list.
+\\[Man-previous-manpage] Jump to previous manpage in circular list.
\\[Man-next-section] Jump to next manpage section.
\\[Man-previous-section] Jump to previous manpage section.
\\[Man-goto-section] Go to a manpage section.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 864726e..62a33f3 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1119,7 +1119,6 @@ completion candidates than this number."
(defvar-local completion-all-sorted-completions nil)
(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil) ;Function that takes down the cycling map.
-(defvar completion-content-when-empty nil)
(defvar completion-fail-discreetly nil
"If non-nil, stay quiet when there is no match.")
@@ -1504,13 +1503,8 @@ If `minibuffer-completion-confirm' is
`confirm-after-completion',
COMPLETION-FUNCTION is called if the current buffer's content does not
appear to be a match."
(cond
- ;; Allow user to specify null string. In the case that
- ;; `completion-content-when-empty' is set, use that instead.
- ((= beg end)
- (when completion-content-when-empty
- (completion--replace beg end completion-content-when-empty))
- (funcall exit-function))
-
+ ;; Allow user to specify null string
+ ((= beg end) (funcall exit-function))
((test-completion (buffer-substring beg end)
minibuffer-completion-table
minibuffer-completion-predicate)
@@ -3865,6 +3859,9 @@ FORMAT-ARGS is non-nil, PROMPT is used as a format control
string, and FORMAT-ARGS are the arguments to be substituted into
it. See `format' for details.
+If DEFAULT is a list, the first element is used as the default.
+If not, the element is used as is.
+
If DEFAULT is nil, no \"default value\" string is included in the
return value."
(concat
@@ -3872,7 +3869,10 @@ return value."
prompt
(apply #'format prompt format-args))
(and default
- (format minibuffer-default-prompt-format default))
+ (format minibuffer-default-prompt-format
+ (if (consp default)
+ (car default)
+ default)))
": "))
(provide 'minibuffer)
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 958c10a..7796df4 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -316,9 +316,10 @@ Every next/previous file in the defined sequence is
visited by
(defun multi-isearch-read-files ()
"Return a list of files specified interactively, one by one."
;; Most code from `multi-occur'.
- (let* ((files (list (read-file-name "First file to search: "
- default-directory
- buffer-file-name)))
+ (let* ((files (list (read-file-name
+ (format-prompt "First file to search: "
+ (file-name-nondirectory
buffer-file-name))
+ default-directory buffer-file-name)))
(file nil))
(while (not (string-equal
(setq file (read-file-name
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 47fe4de..d22b7ab 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -2750,7 +2750,9 @@ If stopped, start playback."
(if current-prefix-arg
;; FIXME: We should provide some completion here, especially for the
;; case where the user specifies a local socket/file name.
- (setq mpc-host (read-string "MPD host and port: " nil nil mpc-host)))
+ (setq mpc-host (read-string
+ (format-prompt "MPD host and port" mpc-host)
+ nil nil mpc-host)))
nil))
(let* ((song-buf (mpc-songs-buf))
(song-win (get-buffer-window song-buf 0)))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 2b8d4d0..e7dad48 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -922,7 +922,7 @@ opposite of the browser kind of
`browse-url-browser-function'."
'external
'internal))
(k (intern (completing-read
- (format "Browser kind (default %s): " default)
+ (format-prompt "Browser kind" default)
'(internal external)
nil t nil nil
default))))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 639b766..5afc7f1 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -168,6 +168,19 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
+(defconst dbus-error-unknown-interface
+ (concat dbus-error-dbus ".UnknownInterface")
+ "Interface you invoked a method on isn't known by the object.")
+
+(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod")
+ "Method name you invoked isn't known by the object you invoked it on.")
+
+(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject")
+ "Object you invoked a method on isn't known.")
+
+(defconst dbus-error-unknown-property (concat dbus-error-dbus
".UnknownProperty")
+ "Property you tried to access isn't known by the object.")
+
;;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
@@ -565,8 +578,9 @@ placed in the queue.
`:already-owner': Service is already the primary owner."
;; Add Peer handler.
- (dbus-register-method bus service nil dbus-interface-peer "Ping"
- #'dbus-peer-handler 'dont-register)
+ (dbus-register-method
+ bus service nil dbus-interface-peer "Ping"
+ #'dbus-peer-handler 'dont-register)
;; Add ObjectManager handler.
(dbus-register-method
@@ -802,7 +816,7 @@ received. It must accept the input arguments of METHOD.
The
return value of HANDLER is used for composing the returning D-Bus
message. If HANDLER returns a reply message with an empty
argument list, HANDLER must return the symbol `:ignore' in order
-to distinguish it from `nil' (the boolean false).
+to distinguish it from nil (the boolean false).
If HANDLER detects an error, it shall return the list `(:error
ERROR-NAME ERROR-MESSAGE)'. ERROR-NAME is a namespaced string
@@ -1183,7 +1197,8 @@ check whether SERVICE is already running, you can instead
write
"Default handler for the \"org.freedesktop.DBus.Peer\" interface.
It will be registered for all objects created by `dbus-register-service'."
(let* ((last-input-event last-input-event)
- (method (dbus-event-member-name last-input-event)))
+ (method (dbus-event-member-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
(cond
;; "Ping" does not return an output parameter.
((string-equal method "Ping")
@@ -1193,7 +1208,11 @@ It will be registered for all objects created by
`dbus-register-service'."
(signal
'dbus-error
(list
- (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+ (format "%s.GetMachineId not implemented" dbus-interface-peer))))
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-peer method path))))))
;;; D-Bus introspection.
@@ -1385,37 +1404,38 @@ string and a member of the list returned by
(defun dbus-introspect-get-signature
(bus service path interface name &optional direction)
- "Return signature of a `method' or `signal' represented by NAME as a string.
+ "Return signature of a `method', `property' or `signal' represented by NAME.
If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
If DIRECTION is nil, \"in\" is assumed.
-If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must
-be \"out\"."
+If NAME is a `signal' or a `property', DIRECTION is ignored."
;; For methods, we use "in" as default direction.
(let ((object (or (dbus-introspect-get-method
bus service path interface name)
(dbus-introspect-get-signal
+ bus service path interface name)
+ (dbus-introspect-get-property
bus service path interface name))))
- (when (and (string-equal
- "method" (dbus-introspect-get-attribute object "name"))
- (not (stringp direction)))
+ (when (and (eq 'method (car object)) (not (stringp direction)))
(setq direction "in"))
;; In signals, no direction is given.
- (when (string-equal "signal" (dbus-introspect-get-attribute object "name"))
+ (when (eq 'signal (car object))
(setq direction nil))
;; Collect the signatures.
- (mapconcat
- (lambda (x)
- (let ((arg (dbus-introspect-get-argument
- bus service path interface name x)))
- (if (or (not (stringp direction))
- (string-equal
- direction
- (dbus-introspect-get-attribute arg "direction")))
- (dbus-introspect-get-attribute arg "type")
- "")))
- (dbus-introspect-get-argument-names bus service path interface name)
- "")))
+ (if (eq 'property (car object))
+ (dbus-introspect-get-attribute object "type")
+ (mapconcat
+ (lambda (x)
+ (let ((arg (dbus-introspect-get-argument
+ bus service path interface name x)))
+ (if (or (not (stringp direction))
+ (string-equal
+ direction
+ (dbus-introspect-get-attribute arg "direction")))
+ (dbus-introspect-get-attribute arg "type")
+ "")))
+ (dbus-introspect-get-argument-names bus service path interface name)
+ ""))))
;;; D-Bus properties.
@@ -1423,7 +1443,7 @@ be \"out\"."
(defun dbus-get-property (bus service path interface property)
"Return the value of PROPERTY of INTERFACE.
It will be checked at BUS, SERVICE, PATH. The result can be any
-valid D-Bus value, or nil if there is no PROPERTY."
+valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read."
(dbus-ignore-errors
;; "Get" returns a variant, so we must use the `car'.
(car
@@ -1431,17 +1451,23 @@ valid D-Bus value, or nil if there is no PROPERTY."
bus service path dbus-interface-properties
"Get" :timeout 500 interface property))))
-(defun dbus-set-property (bus service path interface property value)
+(defun dbus-set-property (bus service path interface property &rest args)
"Set value of PROPERTY of INTERFACE to VALUE.
-It will be checked at BUS, SERVICE, PATH. When the value is
-successfully set return VALUE. Otherwise, return nil."
+It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
+by a TYPE symbol. When the value is successfully set return
+VALUE. Otherwise, return nil.
+
+\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
(dbus-ignore-errors
;; "Set" requires a variant.
(dbus-call-method
bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
- ;; Return VALUE.
- (dbus-get-property bus service path interface property)))
+ "Set" :timeout 500 interface property (cons :variant args))
+ ;; Return VALUE. The property could have the `:write' access type,
+ ;; so we ignore errors in `dbus-get-property'.
+ (dbus-ignore-errors
+ (or (dbus-get-property bus service path interface property)
+ (if (symbolp (car args)) (cadr args) (car args))))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
@@ -1459,13 +1485,14 @@ nil is returned."
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out not matching PATH."
;; Remove entries not belonging to this case.
- (seq-remove
+ (seq-filter
(lambda (item)
- (not (string-equal path (nth 2 item))))
+ (string-equal path (nth 2 item)))
(gethash (list :property bus interface property)
dbus-registered-objects-table)))
-(defun dbus-get-other-registered-property (bus _service path interface
property)
+(defun dbus-get-other-registered-properties
+ (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out matching PATH."
;; Remove matching entries.
@@ -1476,8 +1503,7 @@ Filter out matching PATH."
dbus-registered-objects-table)))
(defun dbus-register-property
- (bus service path interface property access value
- &optional emits-signal dont-register-service)
+ (bus service path interface property access &rest args)
"Register PROPERTY on the D-Bus BUS.
BUS is either a Lisp symbol, `:system' or `:session', or a string
@@ -1491,9 +1517,11 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE
is the
name of the interface used at PATH, PROPERTY is the name of the
property of INTERFACE. ACCESS indicates, whether the property
can be changed by other services via D-Bus. It must be either
-the symbol `:read', `:write' or `:readwrite'. VALUE is the
-initial value of the property, it can be of any valid type (see
-`dbus-call-method' for details).
+the symbol `:read', `:write' or `:readwrite'.
+
+VALUE is the initial value of the property, it can be of any
+valid type (see `dbus-call-method' for details). VALUE can be
+preceded by a TYPE symbol.
If PROPERTY already exists on PATH, it will be overwritten. For
properties with access type `:read' this is the only way to
@@ -1511,52 +1539,72 @@ not registered. This means that other D-Bus clients
have no way
of noticing the newly registered property. When interfaces are
constructed incrementally by adding single methods or properties
at a time, DONT-REGISTER-SERVICE can be used to prevent other
-clients from discovering the still incomplete interface."
- (unless (member access '(:read :write :readwrite))
- (signal 'wrong-type-argument (list "Access type invalid" access)))
-
- ;; Add handlers for the three property-related methods.
- (dbus-register-method
- bus service path dbus-interface-properties "Get"
- #'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "GetAll"
- #'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "Set"
- #'dbus-property-handler 'dont-register)
-
- ;; Register SERVICE.
- (unless (or dont-register-service (member service (dbus-list-names bus)))
- (dbus-register-service bus service))
-
- ;; Send the PropertiesChanged signal.
- (when emits-signal
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- (if (member access '(:read :readwrite))
- `(:array (:dict-entry ,property (:variant ,value)))
- '(:array: :signature "{sv}"))
- (if (eq access :write)
- `(:array ,property)
- '(:array))))
-
- ;; Create a hash table entry. We use nil for the unique name,
- ;; because the property might be accessed from anybody.
- (let ((key (list :property bus interface property))
- (val
- (cons
- (list
- nil service path
- (cons
- (if emits-signal (list access :emits-signal) (list access))
- value))
- (dbus-get-other-registered-property
- bus service path interface property))))
- (puthash key val dbus-registered-objects-table)
-
- ;; Return the object.
- (list key (list service path))))
+clients from discovering the still incomplete interface.
+
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
+ (let ((type (when (symbolp (car args)) (pop args)))
+ (value (pop args))
+ (emits-signal (pop args))
+ (dont-register-service (pop args)))
+ (unless (member access '(:read :write :readwrite))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
+ (unless type
+ (setq type
+ (cond
+ ((memq value '(t nil)) :boolean)
+ ((natnump value) :uint32)
+ ((fixnump value) :int32)
+ ((floatp value) :double)
+ ((stringp value) :string)
+ (t
+ (signal 'wrong-type-argument (list "Value type invalid"
value))))))
+
+ ;; Add handlers for the three property-related methods.
+ (dbus-register-method
+ bus service path dbus-interface-properties "Get"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "GetAll"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "Set"
+ #'dbus-property-handler 'dont-register)
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Send the PropertiesChanged signal.
+ (when emits-signal
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ (if (member access '(:read :readwrite))
+ `(:array
+ (:dict-entry
+ ,property
+ ,(if type (list :variant type value) (list :variant value))))
+ '(:array: :signature "{sv}"))
+ (if (eq access :write)
+ `(:array ,property)
+ '(:array))))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the property might be accessed from anybody.
+ (let ((key (list :property bus interface property))
+ (val
+ (cons
+ (list
+ nil service path
+ (cons
+ (if emits-signal (list access :emits-signal) (list access))
+ (if type (list type value) (list value))))
+ (dbus-get-other-registered-properties
+ bus service path interface property))))
+ (puthash key val dbus-registered-objects-table)
+
+ ;; Return the object.
+ (list key (list service path)))))
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
@@ -1575,15 +1623,15 @@ It will be registered for all objects created by
`dbus-register-property'."
(object (car (last (car entry)))))
(cond
((not (consp object))
- `(:error ,dbus-error-invalid-args
+ `(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
- ((eq (car object) :write)
+ ((memq :write (car object))
`(:error ,dbus-error-access-denied
,(format-message
"Property \"%s\" at path \"%s\" is not readable" property path)))
;; Return the result.
- (t `((:variant ,(cdar (last (car entry)))))))))
+ (t (list :variant (cdar (last (car entry))))))))
;; "Set" expects a variant.
((string-equal method "Set")
@@ -1593,17 +1641,19 @@ It will be registered for all objects created by
`dbus-register-property'."
(object (car (last (car entry)))))
(cond
((not (consp object))
- `(:error ,dbus-error-invalid-args
+ `(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
- ((eq (car object) :read)
+ ((memq :read (car object))
`(:error ,dbus-error-property-read-only
,(format-message
"Property \"%s\" at path \"%s\" is not writable" property path)))
(t (puthash (list :property bus interface property)
- (cons (append (butlast (car entry))
- (list (cons (car object) value)))
- (dbus-get-other-registered-property
+ (cons (append
+ (butlast (car entry))
+ ;; Reuse ACCESS und TYPE from registration.
+ (list (list (car object) (cadr object) value)))
+ (dbus-get-other-registered-properties
bus service path interface property))
dbus-registered-objects-table)
;; Send the "PropertiesChanged" signal.
@@ -1625,18 +1675,25 @@ It will be registered for all objects created by
`dbus-register-property'."
(let (result)
(maphash
(lambda (key val)
- (dolist (item val)
- (when (and (equal (butlast key) (list :property bus interface))
- (string-equal path (nth 2 item))
- (not (functionp (car (last item)))))
- (push
- (list :dict-entry
- (car (last key))
- (list :variant (cdar (last item))))
- result))))
+ (when (consp val)
+ (dolist (item val)
+ (when (and (equal (butlast key) (list :property bus interface))
+ (string-equal path (nth 2 item))
+ (consp (car (last item)))
+ (not (memq :write (caar (last item)))))
+ (push
+ (list :dict-entry
+ (car (last key))
+ (cons :variant (cdar (last item))))
+ result)))))
dbus-registered-objects-table)
;; Return the result, or an empty array.
- (list :array (or result '(:signature "{sv}"))))))))
+ (list :array (or result '(:signature "{sv}")))))
+
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-properties method path))))))
;;; D-Bus object manager.
@@ -1723,7 +1780,7 @@ It will be registered for all objects created by
`dbus-register-service'."
;; Check for object path wildcard interfaces.
(maphash
(lambda (key val)
- (when (and (equal (butlast key 2) (list :method bus))
+ (when (and (equal (butlast key 2) (list :property bus))
(null (nth 2 (car-safe val))))
(push (nth 2 key) interfaces)))
dbus-registered-objects-table)
@@ -1732,7 +1789,7 @@ It will be registered for all objects created by
`dbus-register-service'."
(maphash
(lambda (key val)
(let ((object (or (nth 2 (car-safe val)) "")))
- (when (and (equal (butlast key 2) (list :method bus))
+ (when (and (equal (butlast key 2) (list :property bus))
(string-prefix-p path object))
(dolist (interface (cons (nth 2 key) interfaces))
(unless (assoc object result)
@@ -1842,6 +1899,8 @@ this connection to those buses."
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
+;; * Cache introspection data.
+;;
;; * Run handlers in own threads.
;;; dbus.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 4b897fa3..07aa48a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -307,11 +307,10 @@ If BUFFER, the data to be rendered is in that buffer. In
that
case, this function doesn't actually fetch URL. BUFFER will be
killed after rendering."
(interactive
- (let* ((uris (eww-suggested-uris))
- (prompt (concat "Enter URL or keywords"
- (if uris (format " (default %s)" (car uris)) "")
- ": ")))
- (list (read-string prompt nil 'eww-prompt-history uris)
+ (let ((uris (eww-suggested-uris)))
+ (list (read-string (format-prompt "Enter URL or keywords"
+ (and uris (car uris)))
+ nil 'eww-prompt-history uris)
(prefix-numeric-value current-prefix-arg))))
(setq url (eww--dwim-expand-url url))
(pop-to-buffer-same-window
@@ -668,41 +667,73 @@ Currently this means either text/html or
application/xhtml+xml."
eww-image-link-keymap
eww-link-keymap))))
+(defun eww--limit-string-pixelwise (string pixels)
+ (if (not pixels)
+ string
+ (with-temp-buffer
+ (insert string)
+ (if (< (eww--pixel-column) pixels)
+ string
+ ;; Iterate to find appropriate length.
+ (while (and (> (eww--pixel-column) pixels)
+ (not (bobp)))
+ (forward-char -1))
+ ;; Return at least one character.
+ (buffer-substring (point-min) (max (point)
+ (1+ (point-min))))))))
+
+(defun eww--pixel-column ()
+ (if (not (get-buffer-window (current-buffer)))
+ (save-window-excursion
+ ;; Avoid errors if the selected window is a dedicated one,
+ ;; and they just want to insert a document into it.
+ (set-window-dedicated-p nil nil)
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (line-beginning-position) (point))))
+ (car (window-text-pixel-size nil (line-beginning-position) (point)))))
+
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
- (let ((title (plist-get eww-data :title))
+ (let ((title (propertize (plist-get eww-data :title)
+ 'face 'variable-pitch))
(peer (plist-get eww-data :peer))
- (url (plist-get eww-data :url)))
+ (url (propertize (plist-get eww-data :url)
+ 'face 'variable-pitch)))
(when (zerop (length title))
- (setq title "[untitled]"))
+ (setq title (propertize "[untitled]" 'face 'variable-pitch)))
+ ;; This connection has is https.
+ (when peer
+ (add-face-text-property 0 (length title)
+ (if (plist-get peer :warnings)
+ 'eww-invalid-certificate
+ 'eww-valid-certificate)
+ t title))
;; Limit the length of the title so that the host name
;; of the URL is always visible.
(when url
(let* ((parsed (url-generic-parse-url url))
- (host-length (length (format "%s://%s"
- (url-type parsed)
- (url-host parsed))))
- (width (window-width)))
+ (host-length (shr-string-pixel-width
+ (format "%s://%s" (url-type parsed)
+ (url-host parsed))))
+ (width (window-width nil t)))
(cond
;; The host bit is wider than the window, so nix
;; the title.
- ((> (+ host-length 5) width)
+ ((> (+ host-length (shr-string-pixel-width "xxxxx")) width)
(setq title ""))
;; Trim the title.
- ((> (+ (length title) host-length 2) width)
- (setq title (concat
- (substring title 0 (- width
- host-length
- 5))
- "..."))))))
- ;; This connection has is https.
- (when peer
- (setq title
- (propertize title 'face
- (if (plist-get peer :warnings)
- 'eww-invalid-certificate
- 'eww-valid-certificate))))
+ ((> (+ (shr-string-pixel-width (concat title "xx"))
+ host-length)
+ width)
+ (setq title
+ (concat
+ (eww--limit-string-pixelwise
+ title (- width host-length
+ (shr-string-pixel-width
+ (propertize "...: " 'face
+ 'variable-pitch))))
+ (propertize "..." 'face 'variable-pitch)))))))
(replace-regexp-in-string
"%" "%%"
(format-spec
@@ -1135,6 +1166,8 @@ just re-display the HTML already fetched."
(defvar eww-select-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'eww-change-select)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'eww-change-select)
(define-key map [(control c) (control c)] 'eww-submit)
map))
@@ -1437,26 +1470,30 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(setq display (plist-get (cdr elem) :display))))
display))
-(defun eww-change-select ()
+(defun eww--form-items (form)
+ (cl-loop for elem in form
+ when (and (consp elem)
+ (eq (car elem) 'item))
+ collect (cdr elem)))
+
+(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
- (interactive)
- (let* ((input (get-text-property (point) 'eww-form))
- (completion-ignore-case t)
- (options
- (delq nil
- (mapcar (lambda (elem)
- (and (consp elem)
- (eq (car elem) 'item)
- (cons (plist-get (cdr elem) :display)
- (plist-get (cdr elem) :value))))
- input)))
- (display (completing-read "Change value: " options nil 'require-match))
- (inhibit-read-only t))
- ;; If the user doesn't enter anything, don't change anything.
- (when (> (length display) 0)
- (plist-put input :value (cdr (assoc-string display options t)))
- (goto-char
- (eww-update-field display)))))
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
+ (let ((input (get-text-property (point) 'eww-form)))
+ (popup-menu
+ (cons
+ "Change Value"
+ (mapcar
+ (lambda (elem)
+ (vector (plist-get elem :display)
+ (lambda ()
+ (interactive)
+ (plist-put input :value (plist-get elem :value))
+ (goto-char (eww-update-field (plist-get elem :display))))
+ t))
+ (eww--form-items input)))
+ event)))
(defun eww-update-field (string &optional offset)
(unless offset
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 1766e19..f296ae3 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -625,7 +625,7 @@ SERVER-PLIST is the property list for the server."
(default (or (plist-get server-plist :encryption)
"plain")))
(intern
- (completing-read (format "Encryption (default %s): " default)
+ (completing-read (format-prompt "Encryption" default)
choices nil t nil nil default))))
(defun rcirc-keepalive ()
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9644639..7fd48b2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -584,6 +584,11 @@ This regexp must match both `tramp-initial-end-of-output'
and
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
+This variable is, by default, initialised from
+`password-word-equivalents' when Tramp is loaded, and it is
+usually more convenient to add new passphrases to that variable
+instead of altering this variable.
+
The `sudo' program appears to insert a `^@' character into the prompt."
:version "24.4"
:type 'regexp)
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 9947231..71d55cd 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -34,7 +34,7 @@
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
-(require 'nnir)
+(require 'nnselect)
(require 'ol)
@@ -140,9 +140,9 @@ If `org-store-link' was called with a prefix arg the
meaning of
(`(nnvirtual . ,_)
(save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number)))))
- (`(nnir . ,_)
+ (`(nnselect . ,_)
(save-excursion
- (nnir-article-group (gnus-summary-article-number))))
+ (nnselect-article-group (gnus-summary-article-number))))
(_ gnus-newsgroup-name)))
(header (if (eq major-mode 'gnus-article-mode)
;; When in an article, first move to summary
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index f69e062..7b4a59b 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -45,7 +45,7 @@
;; Installation
;;
;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs-Lisp load path, add the following into your init file:
+;; Emacs Lisp load path, add the following into your init file:
;;
;; (require 'handwrite)
;;
diff --git a/lisp/printing.el b/lisp/printing.el
index b8879be..86a2434 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -5284,22 +5284,18 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-n-up (mess)
- (or (stringp mess) (setq mess "*"))
- (save-match-data
- (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
- (prompt "")
- (str (read-string (format fmt-prompt prompt mess) nil nil "1"))
- int)
- (while (if (string-match "^\\s *[0-9]+$" str)
- (setq int (string-to-number str)
- prompt (cond ((< int 1) "Integer below 1; ")
- ((> int 100) "Integer above 100; ")
- (t nil)))
- (setq prompt "Invalid integer syntax; "))
- (ding)
- (setq str
- (read-string (format fmt-prompt prompt mess) str nil "1")))
- int)))
+ (unless (stringp mess)
+ (setq mess "*"))
+ (let (int)
+ (while (or (< (setq int (read-number (format "[%s] N-up printing:" mess)
1))
+ 0)
+ (> int 100))
+ (if (< int 0)
+ (message "Integer below 1")
+ (message "Integer above 100"))
+ (sit-for 1)
+ (ding))
+ int))
(defun pr-interactive-dir (mess)
@@ -5323,7 +5319,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-regexp (mess)
- (read-string (format "[%s] File regexp to print: " mess) nil nil ""))
+ (read-string (format "[%s] File regexp to print: " mess)))
(defun pr-interactive-dir-args (mess)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 3243e64..0a5ddc1 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -816,7 +816,7 @@ If MODE is `cpu' or `cpu+mem', time-based profiler will be
started.
Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
(interactive
(list (if (not (fboundp 'profiler-cpu-start)) 'mem
- (intern (completing-read "Mode (default cpu): "
+ (intern (completing-read (format-prompt "Mode" "cpu")
'("cpu" "mem" "cpu+mem")
nil t nil nil "cpu")))))
(cl-ecase mode
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 7b8b174..7ff424c 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -9102,7 +9102,7 @@ This function might do hidden buffer changes."
(let
((cdd-pos (point)) cdd-next-pos cdd-id-start cdd-id-end
cdd-decl-res cdd-got-func cdd-got-type cdd-got-init
- c-last-identifier-range cdd-exhausted)
+ c-last-identifier-range cdd-exhausted cdd-after-block)
;; The following `while' applies `cdd-function' to a single declarator id
;; each time round. It loops only when CDD-LIST is non-nil.
@@ -9155,23 +9155,25 @@ This function might do hidden buffer changes."
(c-forward-syntactic-ws cdd-limit)
(setq cdd-exhausted t))) ; unbalanced parens
- (cdd-got-init ; "=" sign OR opening "(", "[", or "{"
- ;; Skip an initializer expression. If we're at a '='
- ;; then accept a brace list directly after it to cope
- ;; with array initializers. Otherwise stop at braces
- ;; to avoid going past full function and class blocks.
- (if (and (if (and (eq cdd-got-init ?=)
- (= (c-forward-token-2 1 nil cdd-limit) 0)
- (looking-at "{"))
- (c-go-list-forward (point) cdd-limit)
- t)
- ;; FIXME: Should look for c-decl-end markers here;
- ;; we might go far into the following declarations
- ;; in e.g. ObjC mode (see e.g. methods-4.m).
- (c-syntactic-re-search-forward "[;,{]" cdd-limit 'move t))
+ (cdd-got-init ; "=" sign OR opening "(", "[", or "("
+ ;; Skip an initializer expression in braces, whether or not (in
+ ;; C++ Mode) preceded by an "=". Be careful that the brace list
+ ;; isn't a code block or a struct (etc.) block.
+ (cond
+ ((and (eq cdd-got-init ?=)
+ (zerop (c-forward-token-2 1 nil cdd-limit))
+ (eq (char-after) ?{)
+ (c-go-list-forward (point) cdd-limit)))
+ ((and (eq cdd-got-init ?{)
+ c-recognize-bare-brace-inits
+ (setq cdd-after-block
+ (save-excursion
+ (c-go-list-forward (point) cdd-limit)))
+ (not (c-looking-at-statement-block)))
+ (goto-char cdd-after-block)))
+ (if (c-syntactic-re-search-forward "[;,{]" cdd-limit 'move t)
(backward-char)
- (setq cdd-exhausted t)
- ))
+ (setq cdd-exhausted t)))
(t (c-forward-syntactic-ws cdd-limit)))
@@ -11749,7 +11751,22 @@ comment at the start of cc-engine.el for more info."
(save-excursion (c-backward-syntactic-ws) (point))
nil nil))
(and (consp res)
- (eq (car res) after-type-id-pos))))))
+ (cond
+ ((eq (car res) after-type-id-pos))
+ ((> (car res) after-type-id-pos) nil)
+ (t
+ (catch 'find-decl
+ (save-excursion
+ (goto-char (car res))
+ (c-do-declarators
+ (point-max) t nil nil
+ (lambda (id-start id-end tok not-top func init)
+ (cond
+ ((> id-start after-type-id-pos)
+ (throw 'find-decl nil))
+ ((eq id-start after-type-id-pos)
+ (throw 'find-decl t)))))
+ nil)))))))))
(cons bufpos (or in-paren inexpr-brace-list)))
((or (eq (char-after) ?\;)
;; Brace lists can't contain a semicolon, so we're done.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 13e3ecc..c4c6ad2 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3702,6 +3702,20 @@ Foo bar = gnu;"
c++ t)
(c-lang-defvar c-recognize-paren-inits (c-lang-const c-recognize-paren-inits))
+(c-lang-defconst c-recognize-bare-brace-inits
+ "Non-nil means that brace initializers without \"=\" exist,
+i.e. constructs like
+
+int foo[] {1, 2, 3};
+
+in addition to the more classic
+
+int foo[] = {1, 2, 3};"
+ t nil
+ c++ t)
+(c-lang-defvar c-recognize-bare-brace-inits
+ (c-lang-const c-recognize-bare-brace-inits))
+
(c-lang-defconst c-recognize-paren-inexpr-blocks
"Non-nil to recognize gcc style in-expression blocks,
i.e. compound statements surrounded by parentheses inside expressions."
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 1b1920b..13b672b 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2913,11 +2913,8 @@ attempts to find a file whose name is produced by
(format FMT FILENAME)."
(and w (progn (compilation-set-window w marker)
(compilation-set-overlay-arrow w))))
(let* ((name (read-file-name
- (format "Find this %s in%s: "
- compilation-error
- (if filename
- (format " (default %s)" filename)
- ""))
+ (format-prompt "Find this %s in"
+ filename compilation-error)
spec-dir filename t nil
;; The predicate below is fine when called from
;; minibuffer-complete-and-exit, but it's too
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 7a1c2e4..af179e2 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -6306,8 +6306,7 @@ Customized by setting variables
`cperl-shrink-wrap-info-frame',
(interactive
(let* ((default (cperl-word-at-point))
(read (read-string
- (format "Find doc for Perl function (default %s): "
- default))))
+ (format-prompt "Find doc for Perl function" default))))
(list (if (equal read "")
default
read))))
@@ -8266,10 +8265,7 @@ the appropriate statement modifier."
(interactive
(list (let* ((default-entry (cperl-word-at-point))
(input (read-string
- (format "perldoc entry%s: "
- (if (string= default-entry "")
- ""
- (format " (default %s)" default-entry))))))
+ (format-prompt "perldoc entry" default-entry))))
(if (string= input "")
(if (string= default-entry "")
(error "No perldoc args given")
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 2c5c365..81cb2b7 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -292,7 +292,7 @@ file the tag was in."
(or (locate-dominating-file default-directory "TAGS")
default-directory)))
(list (read-file-name
- "Visit tags table (default TAGS): "
+ (format-prompt "Visit tags table" "TAGS")
;; default to TAGS from default-directory up to root.
default-tag-dir
(expand-file-name "TAGS" default-tag-dir)
@@ -625,7 +625,7 @@ Returns t if it visits a tags table, or nil if there are no
more in the list."
(car list))
;; Finally, prompt the user for a file name.
(expand-file-name
- (read-file-name "Visit tags table (default TAGS): "
+ (read-file-name (format-prompt "Visit tags table" "TAGS")
default-directory
"TAGS"
t))))))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 9f34a37..59db646 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -554,10 +554,7 @@ Used by these commands to determine defaults."
;;; Reads a string from the user.
(defun lisp-symprompt (prompt default)
- (list (let* ((prompt (if default
- (format "%s (default %s): " prompt default)
- (concat prompt ": ")))
- (ans (read-string prompt)))
+ (list (let ((ans (read-string (format-prompt prompt default))))
(if (zerop (length ans)) default ans))))
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 3dd9b8d..55a78c6 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1048,10 +1048,9 @@ directory and makes this the current buffer's default
directory."
(save-excursion
(skip-syntax-backward "-(")
(thing-at-point 'symbol)))))
- (completing-read
- (format (if def "Function (default %s): " "Function: ") def)
- (inferior-octave-completion-table)
- nil nil nil nil def)))
+ (completing-read (format-prompt "Function" def)
+ (inferior-octave-completion-table)
+ nil nil nil nil def)))
(defun octave-goto-function-definition (fn)
"Go to the function definition of FN in current buffer."
@@ -1172,10 +1171,7 @@ q: Don't fix\n" func file))
(min (line-end-position 4) end)
t)
(match-string 1))))
- (old-func (read-string (format (if old-func
- "Name to replace (default %s): "
- "Name to replace: ")
- old-func)
+ (old-func (read-string (format-prompt "Name to replace" old-func)
nil nil old-func)))
(if (and func old-func (not (equal func old-func)))
(perform-replace old-func func 'query
@@ -1454,7 +1450,7 @@ The block marked is the one that contains point or
follows point."
Prompt for the function's name, arguments and return values (to be
entered without parens)."
(let* ((defname (file-name-sans-extension (buffer-name)))
- (name (read-string (format "Function name (default %s): " defname)
+ (name (read-string (format-prompt "Function name" defname)
nil nil defname))
(args (read-string "Arguments: "))
(vals (read-string "Return values: ")))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index a209d21..fa281dd 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -2369,12 +2369,8 @@ In effect it sets the `fill-prefix' when inside comments
and then calls
;; in prolog-help-function-i
(t
(let* ((word (prolog-atom-under-point))
- (predicate (read-string
- (format "Help on predicate%s: "
- (if word
- (concat " (default " word ")")
- ""))
- nil nil word))
+ (predicate (read-string (format-prompt "Help on predicate" word)
+ nil nil word))
;;point
)
(if prolog-help-function-i
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d83af83..ccbcb08 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4585,9 +4585,7 @@ Interactively, prompt for symbol."
(interactive
(let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
+ (list (read-string (format-prompt "Describe symbol" symbol)
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 5a47594..3c249b7 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2206,8 +2206,7 @@ Shell script files can cause this function be called
automatically
when the file is visited by having a `sh-shell' file-local variable
whose value is the shell name (don't quote it)."
(interactive (list (completing-read
- (format "Shell (default %s): "
- sh-shell-file)
+ (format-prompt "Shell" sh-shell-file)
;; This used to use interpreter-mode-alist, but that is
;; no longer appropriate now that uses regexps.
;; Maybe there could be a separate variable that lists
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 7ffa6d4..33aad2d 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1346,9 +1346,8 @@ Prefix argument means invert sense of
`tcl-use-smart-word-finder'."
(not tcl-use-smart-word-finder)
tcl-use-smart-word-finder))))
(completing-read
- (if (or (null word) (string= word ""))
- "Help on Tcl command: "
- (format "Help on Tcl command (default %s): " word))
+ (format-prompt "Help on Tcl command: "
+ (and (not (equal word "")) word))
tcl-help-alist nil t nil nil word)))
current-prefix-arg))
(if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
diff --git a/lisp/rect.el b/lisp/rect.el
index 9922aac..ebf309a 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -521,8 +521,9 @@ Called from a program, takes three args; START, END and
STRING."
#'rectangle--string-erase-preview nil t)
(add-hook 'post-command-hook
#'rectangle--string-preview nil t))
- (read-string (format "String rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt
+ "String rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)
'inherit-input-method))))))
@@ -549,8 +550,8 @@ This command does not delete or overwrite any existing
text."
(list
(region-beginning)
(region-end)
- (read-string (format "String insert rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt "String insert rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
(apply-on-rectangle 'string-rectangle-line start end string nil))
diff --git a/lisp/replace.el b/lisp/replace.el
index 69092c1..a751822 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -208,12 +208,15 @@ wants to replace FROM with TO."
(minibuffer-allow-text-properties t) ; separator uses text-properties
(prompt
(cond ((and query-replace-defaults separator)
- (format "%s (default %s): " prompt (car
minibuffer-history)))
+ (format-prompt prompt (car minibuffer-history)))
(query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (caar query-replace-defaults))
- (query-replace-descr (cdar
query-replace-defaults))))
- (t (format "%s: " prompt))))
+ (format-prompt
+ prompt (format "%s -> %s"
+ (query-replace-descr
+ (caar query-replace-defaults))
+ (query-replace-descr
+ (cdar query-replace-defaults)))))
+ (t (format-prompt prompt nil))))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
@@ -1487,7 +1490,7 @@ which means to discard all text properties."
;; Get the regexp for collection pattern.
(let ((default (car occur-collect-regexp-history)))
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
diff --git a/lisp/server.el b/lisp/server.el
index 9934e1c..436a6ca 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -728,7 +728,8 @@ If server is running, it is first stopped.
NAME defaults to `server-name'. With argument, ask for NAME."
(interactive
(list (if current-prefix-arg
- (read-string "Server name: " nil nil server-name))))
+ (read-string (format-prompt "Server name" server-name)
+ nil nil server-name))))
(when server-mode (with-temp-message nil (server-mode -1)))
(let ((file (expand-file-name (or name server-name)
(if server-use-tcp
diff --git a/lisp/ses.el b/lisp/ses.el
index 96b219f..a2e6033 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -378,7 +378,7 @@ area of a spreadsheet.")
;; "Side-effect variables". They are set in one function, altered in
;; another as a side effect, then read back by the first, as a way of
;; passing back more than one value. These declarations are just to make
-;; the compiler happy, and to conform to standard Emacs-Lisp practice (I
+;; the compiler happy, and to conform to standard Emacs Lisp practice (I
;; think the make-local-variable trick above is cleaner).
;;
@@ -2540,10 +2540,8 @@ cell formula was unsafe and user declined confirmation."
(if (equal initial "\"")
(progn
(if (not (stringp curval)) (setq curval nil))
- (read-string (if curval
- (format "String Cell %s (default %s): "
- ses--curcell curval)
- (format "String Cell %s: " ses--curcell))
+ (read-string (format-prompt "String Cell %s"
+ curval ses--curcell)
nil 'ses-read-string-history curval))
(read-from-minibuffer
(format "Cell %s: " ses--curcell)
@@ -3007,9 +3005,9 @@ inserts a new row if at bottom of print area. Repeat
COUNT times."
(list col
(if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
- (read-from-minibuffer (format "Column %s width (default %d): "
- (ses-column-letter col)
- (ses-col-width col))
+ (read-from-minibuffer (format-prompt "Column %s width"
+ (ses-col-width col)
+ (ses-column-letter col))
nil ; No initial contents.
nil ; No override keymap.
t ; Convert to Lisp object.
diff --git a/lisp/simple.el b/lisp/simple.el
index eedbff2..3b2b5c9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2129,11 +2129,9 @@ See also
`minibuffer-history-case-insensitive-variables'."
(interactive
(let* ((enable-recursive-minibuffers t)
(regexp (read-from-minibuffer
- (format "Previous element matching regexp%s: "
- (if minibuffer-history-search-history
- (format " (default %s)"
- (car minibuffer-history-search-history))
- ""))
+ (format-prompt "Previous element matching regexp"
+ (and minibuffer-history-search-history
+ (car
minibuffer-history-search-history)))
nil minibuffer-local-map nil
'minibuffer-history-search-history
(car minibuffer-history-search-history))))
@@ -4374,7 +4372,7 @@ Also, delete any process that is exited or signaled."
((thread-name (process-thread p)))
(t "--")))
(cmd
- (if (memq type '(network serial))
+ (if (memq type '(network serial pipe))
(let ((contact (process-contact p t t)))
(if (eq type 'network)
(format "(%s %s)"
@@ -8312,7 +8310,7 @@ makes it easier to edit it."
(interactive
(let* ((default-var (variable-at-point))
(var (if (custom-variable-p default-var)
- (read-variable (format "Set variable (default %s): "
default-var)
+ (read-variable (format-prompt "Set variable" default-var)
default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form `(describe-variable ',var))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 5b98eb36..aab6a3a 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1759,8 +1759,9 @@ This is based on `speedbar-initial-expansion-list-name'
referencing
"Change speedbar's default expansion list to NEW-DEFAULT."
(interactive
(list
- (completing-read (format "Speedbar Mode (default %s): "
- speedbar-previously-used-expansion-list-name)
+ (completing-read (format-prompt
+ "Speedbar Mode"
+ speedbar-previously-used-expansion-list-name)
speedbar-initial-expansion-mode-alist
nil t "" nil
speedbar-previously-used-expansion-list-name)))
diff --git a/lisp/subr.el b/lisp/subr.el
index b020d09..3529771 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1828,6 +1828,7 @@ FUN is then called once."
(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
"Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."
+ (declare (debug (form sexp body)))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index cee88cb..d8f932e 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -665,7 +665,8 @@ to get the name of the last visited tab, the second last,
and so on."
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
(tab-bar--tabs-recent))))
- (list (completing-read "Switch to tab by name (default recent): "
+ (list (completing-read (format-prompt "Switch to tab by name"
+ (car recent-tabs))
recent-tabs nil nil nil nil recent-tabs))))
(tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0))))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index e8c4dc4..108f9f7 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -642,6 +642,15 @@ using the `previous-buffer' command."
(with-selected-window window
(switch-to-buffer buffer))))))
+(defcustom tab-line-switch-cycling nil
+ "Enable cycling tab switch.
+If non-nil, `tab-line-switch-to-prev-tab' in the first tab
+switches to the last tab and `tab-line-switch-to-next-tab' in the
+last tab switches to the first tab."
+ :type 'boolean
+ :group 'tab-line
+ :version "28.1")
+
(defun tab-line-switch-to-prev-tab (&optional mouse-event)
"Switch to the previous tab.
Its effect is the same as using the `previous-buffer' command
@@ -652,13 +661,16 @@ Its effect is the same as using the `previous-buffer'
command
(switch-to-prev-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1- (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= pos 0))
+ (nth (1- (length tabs)) tabs)
+ (nth (1- pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -673,13 +685,16 @@ Its effect is the same as using the `next-buffer' command
(switch-to-next-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1+ (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= (length tabs) (1+
pos)))
+ (car tabs)
+ (nth (1+ pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -764,11 +779,15 @@ from the tab line."
(global-set-key [tab-line mouse-5] 'tab-line-hscroll-right)
(global-set-key [tab-line wheel-up] 'tab-line-hscroll-left)
(global-set-key [tab-line wheel-down] 'tab-line-hscroll-right)
+(global-set-key [tab-line wheel-left] 'tab-line-hscroll-left)
+(global-set-key [tab-line wheel-right] 'tab-line-hscroll-right)
(global-set-key [tab-line S-mouse-4] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-mouse-5] 'tab-line-switch-to-next-tab)
(global-set-key [tab-line S-wheel-up] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-wheel-down] 'tab-line-switch-to-next-tab)
+(global-set-key [tab-line S-wheel-left] 'tab-line-switch-to-prev-tab)
+(global-set-key [tab-line S-wheel-right] 'tab-line-switch-to-next-tab)
(provide 'tab-line)
diff --git a/lisp/term.el b/lisp/term.el
index e77c2c1..f0470d8 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -4278,8 +4278,7 @@ well as the newer ports COM10 and higher."
;; `prompt': The most recently used port is provided as
;; the default value, which is used when the user
;; simply presses return.
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
;; `directory': Most systems have their serial ports
;; in the same directory, so start in the directory
;; of the most recently used port, or in a reasonable
@@ -4294,8 +4293,7 @@ well as the newer ports COM10 and higher."
;; serial port.
"")
(read-from-minibuffer
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
nil nil nil '(file-name-history . 1) nil nil))))
(if (or (null x) (and (stringp x) (zerop (length x))))
(setq x h)
@@ -4317,7 +4315,7 @@ Try to be nice by providing useful defaults and history."
(cond ((string= h serial-no-speed)
"Speed (default nil = set by port): ")
(h
- (format "Speed (default %s b/s): " h))
+ (format-prompt "Speed" (format "%s b/s" h)))
(t
(format "Speed (b/s): ")))
nil nil nil '(history . 1) nil nil)))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index cc58798..03edd47 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1356,21 +1356,17 @@ the string PROPERTY."
(defun css--complete-property-value ()
"Complete property value at point."
- (let ((property
- (save-excursion
- (re-search-backward ":[^/]" (line-beginning-position) t)
- (when (eq (char-after) ?:)
- (let ((property-end (point)))
- (skip-chars-backward "-[:alnum:]")
- (let ((prop (buffer-substring (point) property-end)))
- (car (member prop css-property-ids))))))))
+ (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*"
+ (line-beginning-position) t)
+ (member (match-string-no-properties 1)
+ css-property-ids))))
(when property
(let ((end (point)))
(save-excursion
(skip-chars-backward "[:graph:]")
(list (point) end
(append '("inherit" "initial" "unset")
- (css--property-values property))))))))
+ (css--property-values (car property)))))))))
(defvar css--html-tags (mapcar #'car html-tag-alist)
"List of HTML tags.
@@ -1883,12 +1879,9 @@ on what is seen near point."
(list
(let* ((sym (css--mdn-find-symbol))
(enable-recursive-minibuffers t)
- (value (completing-read
- (if sym
- (format "Describe CSS symbol (default %s): " sym)
- "Describe CSS symbol: ")
- css--mdn-completion-list nil nil nil
- 'css--mdn-lookup-history sym)))
+ (value (completing-read (format-prompt "Describe CSS symbol" sym)
+ css--mdn-completion-list nil nil nil
+ 'css--mdn-lookup-history sym)))
(if (equal value "") sym value))))
(when symbol
;; If we see a single-colon pseudo-element like ":after", turn it
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 6889d7e..51ed3a2 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -387,9 +387,13 @@ like <img alt=\"Some thing.\">."
;;*---------------------------------------------------------------------*/
;;* Programming mode */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-prog-text-faces
+(defcustom flyspell-prog-text-faces
'(font-lock-string-face font-lock-comment-face font-lock-doc-face)
- "Faces corresponding to text in programming-mode buffers.")
+ "Faces corresponding to text in programming-mode buffers."
+ :type '(set (const font-lock-string-face)
+ (const font-lock-comment-face)
+ (const font-lock-doc-face))
+ :version "28.1")
(defun flyspell-generic-progmode-verify ()
"Used for `flyspell-generic-check-word-predicate' in programming modes."
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 86452ff..a99dfe4 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -198,14 +198,13 @@ Must be greater than 1."
:type 'integer
:group 'ispell)
-;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread.
-;; Before that, adding it is useless, as if it is found, it will just
-;; cause an error; and one of the other spelling engines below is
-;; almost certainly installed in any case, for enchant to use.
(defcustom ispell-program-name
(or (executable-find "aspell")
(executable-find "ispell")
(executable-find "hunspell")
+ ;; Enchant is commonly installed as `enchant-2', so use this
+ ;; name and avoid old versions of `enchant'.
+ (executable-find "enchant-2")
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
@@ -330,7 +329,7 @@ The function must take one string argument and return a
string."
:group 'ispell)
;; FIXME framepop.el last updated c 2003 (?),
-;; probably something else replaces it these days.
+;; use posframe.
(defcustom ispell-use-framepop-p nil
"When non-nil ispell uses framepop to display choices in a dedicated frame.
You can set this variable to dynamically use framepop if you are in a
@@ -1237,11 +1236,11 @@ If LANG is omitted, get the extra word characters for
the default language."
"Find Enchant's dictionaries, and record in
`ispell-enchant-dictionary-alist'."
(let* ((dictionaries
(split-string
- (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) "
([^)]+)\n"))
+ (ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t))
(found
(mapcar #'(lambda (lang)
`(,lang "[[:alpha:]]" "[^[:alpha:]]"
- ,(ispell--get-extra-word-characters) t nil nil
utf-8))
+ ,(ispell--get-extra-word-characters lang) t nil
nil utf-8))
dictionaries)))
;; Merge into FOUND any elements from the standard
ispell-dictionary-base-alist
;; which have no element in FOUND at all.
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 8d8223a..c8fd0be 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -336,9 +336,9 @@ found on the last `refer-find-entry' or
`refer-find-next-entry'."
(list (expand-file-name
(if (eq major-mode 'bibtex-mode)
(read-file-name
- (format ".bib file (default %s): "
- (file-name-nondirectory
- (buffer-file-name)))
+ (format-prompt ".bib file"
+ (file-name-nondirectory
+ (buffer-file-name)))
(file-name-directory (buffer-file-name))
(file-name-nondirectory (buffer-file-name))
t)
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index b79bb29..4c780d8 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -861,9 +861,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in
another window."
(default (when (looking-back "\\\\\\(?:page\\)?ref{[-a-zA-Z0-9_*.:]*"
(line-beginning-position))
(reftex-this-word "-a-zA-Z0-9_*.:")))
- (label (completing-read (if default
- (format "Label (default %s): " default)
- "Label: ")
+ (label (completing-read (format-prompt "Label" default)
docstruct
(lambda (x) (stringp (car x))) t nil nil
default))
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 5fadec4..f2fcd62 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -2363,7 +2363,7 @@ If user selects enumerations, a further prompt is given.
User need to
input a starting item, for example 'e' for 'A)' style. The position is
also arranged by `rst-insert-list-new-tag'."
(let* ((itemstyle (completing-read
- "Select preferred item style [#.]: "
+ (format-prompt "Select preferred item style" "#.")
rst-initial-items nil t nil nil "#."))
(cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
(match-string 0 itemstyle)))
@@ -2371,21 +2371,23 @@ also arranged by `rst-insert-list-new-tag'."
(save-match-data
(cond
((equal cnt "a")
- (let ((itemno (read-string "Give starting value [a]: "
- nil nil "a")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "a")
+ nil nil "a")))
(downcase (substring itemno 0 1))))
((equal cnt "A")
- (let ((itemno (read-string "Give starting value [A]: "
- nil nil "A")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "A")
+ nil nil "A")))
(upcase (substring itemno 0 1))))
((equal cnt "I")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(rst-arabic-to-roman itemno)))
((equal cnt "i")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(downcase (rst-arabic-to-roman itemno))))
((equal cnt "1")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(number-to-string itemno)))))))
(if no
(setq itemstyle (replace-match no t t itemstyle)))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 04f1ddd..e0ef786 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -779,7 +779,7 @@ If you like tags and attributes in uppercase, customize
(setq sgml-tag-last
(completing-read
(if (> (length sgml-tag-last) 0)
- (format "Tag (default %s): " sgml-tag-last)
+ (format-prompt "Tag" sgml-tag-last)
"Tag: ")
sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
?< str |
@@ -878,9 +878,7 @@ With prefix argument, only self insert."
(list (let ((def (save-excursion
(if (eq (following-char) ?<) (forward-char))
(sgml-beginning-of-tag))))
- (completing-read (if def
- (format "Tag (default %s): " def)
- "Tag: ")
+ (completing-read (format-prompt "Tag" def)
sgml-tag-alist nil nil nil
'sgml-tag-history def))))
(or (and tag (> (length tag) 0))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 33f181b..cfe6ce5 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1824,11 +1824,11 @@ See `table-insert-row' and `table-insert-column'."
(list (intern (let ((completion-ignore-case t)
(default (car table-insert-row-column-history)))
(downcase (completing-read
- (format "Insert %s row%s/column%s (default %s):
"
- (if (> n 1) (format "%d" n) "a")
- (if (> n 1) "s" "")
- (if (> n 1) "s" "")
- default)
+ (format-prompt
+ "Insert %s row%s/column%s" default
+ (if (> n 1) (format "%d" n) "a")
+ (if (> n 1) "s" "")
+ (if (> n 1) "s" ""))
'(("row") ("column"))
nil t nil 'table-insert-row-column-history
default))))
n)))
@@ -2534,7 +2534,7 @@ DIRECTION is one of symbols; right, left, above or below."
(caar direction-list)))
(completion-ignore-case t))
(intern (downcase (completing-read
- (format "Span into (default %s): " default-direction)
+ (format-prompt "Span into" default-direction)
direction-list
nil t nil 'table-cell-span-direction-history
default-direction))))))
(unless (memq direction '(right left above below))
@@ -2697,7 +2697,7 @@ Creates a cell on the left and a cell on the right of the
current point location
("Title"
("Split" . "split") ("Left" . "left")
("Right" . "right"))))
(downcase (completing-read
- (format "Existing cell contents to (default %s): "
default)
+ (format-prompt "Existing cell contents to" default)
'(("split") ("left") ("right"))
nil t nil 'table-cell-split-contents-to-history
default)))))))
(unless (eq contents-to 'split)
@@ -2769,7 +2769,7 @@ ORIENTATION is a symbol either horizontally or
vertically."
(completion-ignore-case t)
(default (car table-cell-split-orientation-history)))
(intern (downcase (completing-read
- (format "Split orientation (default %s): " default)
+ (format-prompt "Split orientation" default)
'(("horizontally") ("vertically"))
nil t nil 'table-cell-split-orientation-history
default))))))
(unless (memq orientation '(horizontally vertically))
@@ -2789,7 +2789,7 @@ WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a
symbol
(completion-ignore-case t)
(default (car table-target-history)))
(intern (downcase (completing-read
- (format "Justify what (default %s): " default)
+ (format-prompt "Justify what" default)
'(("cell") ("row") ("column"))
nil t nil 'table-target-history default))))
(table--query-justification)))
@@ -2943,7 +2943,7 @@ CALS (DocBook DTD):
(completion-ignore-case t)
(default (car table-source-language-history))
(language (downcase (completing-read
- (format "Language (default %s): " default)
+ (format-prompt "Language" default)
table-source-languages
nil t nil 'table-source-language-history
default))))
(list
@@ -3366,7 +3366,7 @@ Example:
(let* ((completion-ignore-case t)
(default (car table-sequence-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-sequence-justify-history
default)))))))
(unless (or (called-interactively-p 'interactive) (table--probe-cell))
@@ -3668,7 +3668,7 @@ companion command to `table-capture' this way.
(if (and (string= col-delim-regexp "") (string= row-delim-regexp ""))
'left
(intern
(downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-capture-justify-history default)))))
(if (and (string= col-delim-regexp "") (string= row-delim-regexp "")) "1"
@@ -4253,9 +4253,8 @@ cache buffer into the designated cell in the table
buffer."
PROMPT-HISTORY is a cons cell which car is the prompt string and the
cdr is the history symbol."
(let ((default (car (symbol-value (cdr prompt-history)))))
- (read-from-minibuffer
- (format "%s (default %s): " (car prompt-history) default)
- "" nil nil (cdr prompt-history) default))
+ (read-from-minibuffer (format-prompt (car prompt-history) default)
+ "" nil nil (cdr prompt-history) default))
(car (symbol-value (cdr prompt-history))))
(defun table--buffer-substring-and-trim (beg end)
@@ -4312,7 +4311,7 @@ Returns the coordinate of the final point location."
(let* ((completion-ignore-case t)
(default (car table-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right") ("top") ("middle")
("bottom") ("none"))
nil t nil 'table-justify-history default)))))
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index d302fb1..54bb356 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -667,7 +667,7 @@ With a numeric prefix ARG, go back ARG comments."
"Prompt for a change log name."
(let* ((default (change-log-name))
(name (expand-file-name
- (read-file-name (format "Log file (default %s): " default)
+ (read-file-name (format-prompt "Log file" default)
nil default))))
;; Handle something that is syntactically a directory name.
;; Look for ChangeLog or whatever in that directory.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9c41d50..a1fdd11 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -911,10 +911,11 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\"
\"/a/c/foo\")."
If the OLD prefix arg is passed, tell the file NAME of the old file."
(interactive
(let* ((old current-prefix-arg)
- (fs (diff-hunk-file-names current-prefix-arg)))
+ (fs (diff-hunk-file-names current-prefix-arg))
+ (default (diff-find-file-name old 'noprompt)))
(unless fs (error "No file name to look for"))
- (list old (read-file-name (format "File for %s: " (car fs))
- nil (diff-find-file-name old 'noprompt) t))))
+ (list old (read-file-name (format-prompt "File for %s" default (car fs))
+ nil default t))))
(let ((fs (diff-hunk-file-names old)))
(unless fs (error "No file name to look for"))
(push (cons fs name) diff-remembered-files-alist)))
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index 2b1b079..c977291 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1807,11 +1807,9 @@ all marked sessions must be active."
(ediff-show-meta-buffer session-buf)
(setq regexp
(read-string
- (if (stringp default-regexp)
- (format
- "Filter filenames through regular expression
(default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp t)))
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index f6af5a4..8b12209 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -499,15 +499,11 @@ are two possible targets for this %spatch. However,
these files do not exist."
patch-file-name)
(setq patch-file-name
(read-file-name
- (format "Patch is in file%s: "
- (cond ((and buffer-file-name
+ (format-prompt "Patch is in file"
+ (and buffer-file-name
(equal (expand-file-name dir)
- (file-name-directory buffer-file-name)))
- (concat
- " (default "
- (file-name-nondirectory buffer-file-name)
- ")"))
- (t "")))
+ (file-name-directory buffer-file-name))
+ (file-name-nondirectory buffer-file-name)))
dir buffer-file-name 'must-match))
(if (file-directory-p patch-file-name)
(error "Patch file cannot be a directory: %s" patch-file-name)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index f56d31c..52878ba 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -2181,19 +2181,18 @@ a regular expression typed in by the user."
(setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
regexp-A
(read-string
- (format
- "Ignore A-regions matching this regexp (default %s): "
- ediff-regexp-hide-A))
+ (format-prompt
+ "Ignore A-regions matching this regexp" ediff-regexp-hide-A))
regexp-B
(read-string
- (format
- "Ignore B-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore B-regions matching this regexp"
ediff-regexp-hide-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Ignore C-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore C-regions matching this regexp"
ediff-regexp-hide-C))))
(if (eq ediff-hide-regexp-connective 'and)
(setq msg-connective "BOTH"
@@ -2220,20 +2219,18 @@ a regular expression typed in by the user."
ediff-focus-on-regexp-matches-function
regexp-A
(read-string
- (format
- "Focus on A-regions matching this regexp (default %s): "
- ediff-regexp-focus-A))
+ (format-prompt
+ "Focus on A-regions matching this regexp" ediff-regexp-focus-A))
regexp-B
(read-string
- (format
- "Focus on B-regions matching this regexp (default %s): "
- ediff-regexp-focus-B)))
+ (format-prompt
+ "Focus on B-regions matching this regexp" ediff-regexp-focus-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Focus on C-regions matching this regexp (default %s): "
- ediff-regexp-focus-C))))
+ (format-prompt
+ "Focus on C-regions matching this regexp"
+ ediff-regexp-focus-C))))
(if (eq ediff-focus-regexp-connective 'and)
(setq msg-connective "BOTH"
alt-msg-connective "ONE OF"
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 133d210..ae2f8ad 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -566,10 +566,8 @@ expression; only file names that match the regexp are
considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -594,10 +592,8 @@ names. Only the files that are under revision control are
taken into account."
(list (read-directory-name
"Directory to compare with revision:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression" default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -632,10 +628,8 @@ regular expression; only file names that match the regexp
are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -665,10 +659,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store
merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -707,10 +699,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store
merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -735,10 +725,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store
merged files."
(list (read-directory-name
"Directory to merge with revisions:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -767,10 +755,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store
merged files."
"Directory to merge with revisions and ancestors:"
dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default
%s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -1353,16 +1339,18 @@ the merge buffer."
(let (rev1 rev2)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer"))))
(ediff-load-version-control)
;; ancestor-revision=nil
(funcall
@@ -1388,22 +1376,26 @@ the merge buffer."
(let (rev1 rev2 ancestor-rev)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")))
ancestor-rev
- (read-string
- (format-message
- "Ancestor version (default %s's base revision): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (read-string (format-prompt
+ "Ancestor version"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s base revision"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-merge-internal" ediff-version-control-package))
@@ -1503,13 +1495,14 @@ arguments after setting up the Ediff buffers."
(save-buffer (current-buffer)))
(let (rev1 rev2)
(setq rev1
- (read-string
- (format "Revision 1 to compare (default %s's latest revision): "
- (file-name-nondirectory file)))
+ (read-string (format-prompt "Revision 1 to compare"
+ (concat (file-name-nondirectory file)
+ "'s latest revision")))
rev2
(read-string
- (format "Revision 2 to compare (default %s's current state): "
- (file-name-nondirectory file))))
+ (format-prompt "Revision 2 to compare"
+ (concat (file-name-nondirectory file)
+ "'s current state"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-internal" ediff-version-control-package))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index fc8c318..d2d419a 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -2757,15 +2757,14 @@ Otherwise, signal an error."
alternative-default-dir
(not (string-equal alternative-default-dir
(file-name-directory A-file))))
- (read-file-name (format "%s (default %s): "
- prompt (file-name-nondirectory A-file))
+ (read-file-name (format-prompt prompt (file-name-nondirectory A-file))
alternative-default-dir
(concat alternative-default-dir
(file-name-nondirectory A-file))
(and must-match 'confirm)))
;; If there is a default file, use it.
(default-file
- (read-file-name (format "%s (default %s): " prompt default-file)
+ (read-file-name (format-prompt prompt default-file)
;; If emerge-default-last-directories is set, use the
;; directory from the same argument of the last call of
;; Emerge as the default for this argument.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index cd19b4e..1c69bdf 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -244,7 +244,9 @@ If the optional argument STRIDE is present, that is a
step-width to use
when going through the comment ring."
;; Why substring rather than regexp ? -sm
(interactive
- (list (read-string "Comment substring: " nil nil
log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(unless stride (setq stride 1))
(if (string= str "")
(setq str log-edit-last-comment-match)
@@ -261,7 +263,9 @@ when going through the comment ring."
(defun log-edit-comment-search-forward (str)
"Search forwards through comment history for a substring match of STR."
(interactive
- (list (read-string "Comment substring: " nil nil
log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(log-edit-comment-search-backward str -1))
(defun log-edit-comment-to-change-log (&optional whoami file-name)
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index d82cadc..5198bcc 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -403,12 +403,12 @@ should be applied to the background or to the foreground."
(let ((def (vc-working-revision buffer-file-name)))
(if (null current-prefix-arg) def
(vc-read-revision
- (format "Annotate from revision (default %s): " def)
+ (format-prompt "Annotate from revision" def)
(list buffer-file-name) nil def)))
(if (null current-prefix-arg)
vc-annotate-display-mode
(float (string-to-number
- (read-string "Annotate span days (default 20): "
+ (read-string (format-prompt "Annotate span days" 20)
nil nil "20")))))))
(vc-ensure-vc-buffer)
(setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f0a0804..983fb59 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -953,10 +953,9 @@ use."
;; repository, make sure it's a parent of
;; file.
(read-file-name
- (format "create %s repository in: " bk)
+ (format-prompt "create %s repository in" def-dir bk)
default-directory def-dir t nil
(lambda (arg)
- (message "arg %s" arg)
(and (file-directory-p arg)
(string-prefix-p (expand-file-name arg) def-dir)))))))
(let ((default-directory repo-dir))
@@ -2516,11 +2515,8 @@ with its diffs (if the underlying VCS supports that)."
(cond
((eq current-prefix-arg 1)
(let* ((default (thing-at-point 'word t))
- (revision (read-string
- (if default
- (format "Revision to show (default %s): " default)
- "Revision to show: ")
- nil nil default)))
+ (revision (read-string (format-prompt "Revision to show" default)
+ nil nil default)))
(list 1 revision)))
((numberp current-prefix-arg)
(list current-prefix-arg))
@@ -2903,10 +2899,10 @@ backend to NEW-BACKEND, and unregister FILE from the
current backend.
"Delete file and mark it as such in the version control system.
If called interactively, read FILE, defaulting to the current
buffer's file name if it's under version control."
- (interactive (list (read-file-name "VC delete file: " nil
- (when (vc-backend buffer-file-name)
- buffer-file-name)
- t)))
+ (interactive (list (let ((default (when (vc-backend buffer-file-name)
+ buffer-file-name)))
+ (read-file-name "VC delete file" default)
+ nil default t)))
(setq file (expand-file-name file))
(let ((buf (get-file-buffer file))
(backend (vc-backend file)))
@@ -2947,9 +2943,10 @@ buffer's file name if it's under version control."
"Rename file OLD to NEW in both work area and repository.
If called interactively, read OLD and NEW, defaulting OLD to the
current buffer's file name if it's under version control."
- (interactive (list (read-file-name "VC rename file: " nil
- (when (vc-backend buffer-file-name)
- buffer-file-name) t)
+ (interactive (list (let ((default (when (vc-backend buffer-file-name)
+ buffer-file-name)))
+ (read-file-name (format-prompt "VC rename file" default)
+ nil default t))
(read-file-name "Rename to: ")))
;; in CL I would have said (setq new (merge-pathnames new old))
(let ((old-base (file-name-nondirectory old)))
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index c252c0b..e159d18 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -202,8 +202,7 @@ This function is provided for backward compatibility, since
(interactive
(list (let ((default locale-coding-system))
(read-coding-system
- (format "Coding system for system calls (default %s): "
- default)
+ (format-prompt "Coding system for system calls" default)
default))))
(check-coding-system coding-system)
(setq locale-coding-system coding-system))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index f58a0fb..e9799dc 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3181,11 +3181,10 @@ It reads a file name from an editable text field."
(abbreviate-file-name
(if unbound
(read-file-name prompt)
- (let ((prompt2 (format "%s (default %s): " prompt value))
- (dir (file-name-directory value))
+ (let ((dir (file-name-directory value))
(file (file-name-nondirectory value))
(must-match (widget-get widget :must-match)))
- (read-file-name prompt2 dir nil must-match file)))))
+ (read-file-name (format-prompt prompt value) dir nil must-match
file)))))
;;;(defun widget-file-action (widget &optional event)
;;; ;; Read a file name from the minibuffer.
@@ -3297,10 +3296,10 @@ It reads a directory name from an editable text field."
"Read coding-system from minibuffer."
(if (widget-get widget :base-only)
(intern
- (completing-read (format "%s (default %s): " prompt value)
+ (completing-read (format-prompt prompt value)
(mapcar #'list (coding-system-list t)) nil nil nil
coding-system-history))
- (read-coding-system (format "%s (default %s): " prompt value) value)))
+ (read-coding-system (format-prompt prompt value) value)))
(defun widget-coding-system-action (widget &optional event)
(let ((answer
diff --git a/lisp/woman.el b/lisp/woman.el
index 891a126..eeaccea 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1277,14 +1277,11 @@ cache to be re-read."
(test-completion
word-at-point woman-topic-all-completions))
word-at-point)))
- (completing-read
- (if default
- (format "Manual entry (default %s): " default)
- "Manual entry: ")
- woman-topic-all-completions nil 1
- nil
- 'woman-topic-history
- default))))
+ (completing-read (format-prompt "Manual entry" default)
+ woman-topic-all-completions nil 1
+ nil
+ 'woman-topic-history
+ default))))
;; Note that completing-read always returns a string.
(unless (= (length topic) 0)
(cond
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 0743208..d6ca300 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -326,14 +326,15 @@ If non-nil, plugins are enabled. Otherwise, disabled."))
FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name
of the prompt when reading. When the file name the user specified is a
directory, URL is saved at the specified directory as FILE-NAME."
- (let ((save-name (read-file-name
- (format "Save URL `%s' of type `%s' in file/directory: "
- url mime-type)
- xwidget-webkit-download-dir
- (when file-name
- (expand-file-name
- file-name
- xwidget-webkit-download-dir)))))
+ (let* ((default (when file-name
+ (expand-file-name
+ file-name
+ xwidget-webkit-download-dir)))
+ (save-name
+ (read-file-name
+ (format-prompt "Save URL `%s' of type `%s' in file/directory"
+ default url mime-type)
+ xwidget-webkit-download-dir default)))
(if (file-directory-p save-name)
(setq save-name
(expand-file-name (file-name-nondirectory file-name) save-name)))
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 4fce925..af294af 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1252,7 +1252,7 @@ The following usages are expected:
`dbus-method-error-internal':
(dbus-message-internal
- dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+ dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS)
usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
@@ -1508,7 +1508,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
- const char *uname, *path, *interface, *member;
+ const char *uname, *path, *interface, *member, *error_name;
dmessage = dbus_connection_pop_message (connection);
@@ -1544,10 +1544,11 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
path = dbus_message_get_path (dmessage);
interface = dbus_message_get_interface (dmessage);
member = dbus_message_get_member (dmessage);
+ error_name =dbus_message_get_error_name (dmessage);
- XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
+ XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s",
XD_MESSAGE_TYPE_TO_STRING (mtype),
- ui_serial, uname, path, interface, member,
+ ui_serial, uname, path, interface, member, error_name,
XD_OBJECT_TO_STRING (args));
if (mtype == DBUS_MESSAGE_TYPE_INVALID)
@@ -1571,7 +1572,9 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
- event.arg = Fcons (value, args);
+ event.arg = Fcons (value,
+ (mtype == DBUS_MESSAGE_TYPE_ERROR)
+ ? (Fcons (build_string (error_name), args)) : args);
}
else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
@@ -1744,7 +1747,8 @@ syms_of_dbusbind (void)
DEFSYM (QCstruct, ":struct");
DEFSYM (QCdict_entry, ":dict-entry");
- /* Lisp symbols of objects in `dbus-registered-objects-table'. */
+ /* Lisp symbols of objects in `dbus-registered-objects-table'.
+ `:property', which does exist there as well, is not used here. */
DEFSYM (QCserial, ":serial");
DEFSYM (QCmethod, ":method");
DEFSYM (QCsignal, ":signal");
@@ -1822,8 +1826,8 @@ registered methods and properties, UNAME is nil. PATH is
the object
path of the sending object. All of them can be nil, which means a
wildcard then. OBJECT is either the handler to be called when a D-Bus
message, which matches the key criteria, arrives (TYPE `:method' and
-`:signal'), or a cons cell containing the value of the property (TYPE
-`:property').
+`:signal'), or a list containing the value of the property and its
+attributes (TYPE `:property').
For entries of type `:signal', there is also a fifth element RULE,
which keeps the match string the signal is registered with.
diff --git a/src/image.c b/src/image.c
index d8c3466..6ecf6a7 100644
--- a/src/image.c
+++ b/src/image.c
@@ -8276,11 +8276,13 @@ gif_load (struct frame *f, struct image *img)
if (gif == NULL)
{
#if HAVE_GIFERRORSTRING
- image_error ("Cannot open `%s': %s",
- file, build_string (GifErrorString (gif_err)));
-#else
- image_error ("Cannot open `%s'", file);
+ const char *errstr = GifErrorString (gif_err);
+ if (errstr)
+ image_error ("Cannot open `%s': %s", file, build_string (errstr));
+ else
#endif
+ image_error ("Cannot open `%s'", file);
+
return 0;
}
}
@@ -8306,11 +8308,13 @@ gif_load (struct frame *f, struct image *img)
if (!gif)
{
#if HAVE_GIFERRORSTRING
- image_error ("Cannot open memory source `%s': %s",
- img->spec, build_string (GifErrorString (gif_err)));
-#else
- image_error ("Cannot open memory source `%s'", img->spec);
+ const char *errstr = GifErrorString (gif_err);
+ if (errstr)
+ image_error ("Cannot open memory source `%s': %s",
+ img->spec, build_string (errstr));
+ else
#endif
+ image_error ("Cannot open memory source `%s'", img->spec);
return 0;
}
}
@@ -8593,9 +8597,9 @@ gif_load (struct frame *f, struct image *img)
if (error_text)
image_error ("Error closing `%s': %s",
img->spec, build_string (error_text));
-#else
- image_error ("Error closing `%s'", img->spec);
+ else
#endif
+ image_error ("Error closing `%s'", img->spec);
}
/* Maybe fill in the background field while we have ximg handy. */
diff --git a/src/nsmenu.m b/src/nsmenu.m
index e313fc03..a286a80 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -122,7 +122,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f,
deep_p, submenu); */
block_input ();
- pool = [[NSAutoreleasePool alloc] init];
/* Menu may have been created automatically; if so, discard it. */
if ([menu isKindOfClass: [EmacsMenu class]] == NO)
@@ -240,7 +239,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
[[submenu title] UTF8String]);
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
- [pool release];
unblock_input ();
return;
}
@@ -298,7 +296,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
free_menubar_widget_value_tree (first_wv);
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
- [pool release];
unblock_input ();
return;
}
@@ -364,7 +361,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
if (NILP (items))
{
free_menubar_widget_value_tree (first_wv);
- [pool release];
unblock_input ();
return;
}
@@ -395,7 +391,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
if (i == n)
{
free_menubar_widget_value_tree (first_wv);
- [pool release];
unblock_input ();
return;
}
@@ -454,7 +449,6 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu
*submenu)
if (needsSet)
[NSApp setMainMenu: menu];
- [pool release];
unblock_input ();
}
diff --git a/test/file-organization.org b/test/file-organization.org
index 34bd0b9..64c0755 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -1,10 +1,10 @@
-#+TITLE: The Location of Emacs-Lisp Tests
+#+TITLE: The Location of Emacs Lisp Tests
* The Main Emacs Repository
-The Emacs repository contains a very large number of Emacs-Lisp files, many of
+The Emacs repository contains a very large number of Emacs Lisp files, many of
which pre-date both formal package support for Emacs and automated unit
testing.
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 7853c84..cabbf86 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -101,7 +101,9 @@
"Test variables setting with enabling / disabling a custom theme."
;; We load custom-resources/custom--test-theme.el.
(let ((custom-theme-load-path
- `(,(expand-file-name "custom-resources" (file-name-directory #$)))))
+ `(,(expand-file-name
+ "custom-resources"
+ (expand-file-name "lisp" (getenv "EMACS_TEST_DIRECTORY"))))))
(load-theme 'custom--test 'no-confirm 'no-enable)
;; The variables have still their initial values.
(should (equal custom--test-user-option 'foo))
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 7a8402b..10e3b53 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -156,6 +156,46 @@ its getter (Bug#41853)."
(eval-buffer)))
(should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123))))
+(ert-deftest gv-plist-get ()
+ (require 'cl-lib)
+
+ ;; Simple setf usage for plist-get.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (setf (plist-get target :b) "modify")
+ target)
+ '(:a "a" :b "modify" :c "c")))
+
+ ;; Other function (cl-rotatef) usage for plist-get.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :c))
+ target)
+ '(:a "a" :b "c" :c "b")))
+
+ ;; Add new key value pair at top of list if setf for missing key.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (setf (plist-get target :d) "modify")
+ target)
+ '(:d "modify" :a "a" :b "b" :c "c")))
+
+ ;; Rotate with missing value.
+ ;; The value corresponding to the missing key is assumed to be nil.
+ (should (equal (let ((target '(:a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :d))
+ target)
+ '(:d "b" :a "a" :b nil :c "c")))
+
+ ;; Simple setf usage for plist-get. (symbol plist)
+ (should (equal (let ((target '(a "a" b "b" c "c")))
+ (setf (plist-get target 'b) "modify")
+ target)
+ '(a "a" b "modify" c "c")))
+
+ ;; Other function (cl-rotatef) usage for plist-get. (symbol plist)
+ (should (equal (let ((target '(a "a" b "b" c "c")))
+ (cl-rotatef (plist-get target 'b) (plist-get target 'c))
+ target)
+ '(a "a" b "c" c "b"))))
+
;; `ert-deftest' messes up macroexpansion when the test file itself is
;; compiled (see Bug #24402).
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index cb06dd4..dd8ae39 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -1,4 +1,4 @@
-;;; package-test.el --- Tests for the Emacs package system -*-
lexical-binding:t -*-
+;;; package-tests.el --- Tests for the Emacs package system -*-
lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -805,4 +805,4 @@ Must called from within a `tar-mode' buffer."
(provide 'package-test)
-;;; package-test.el ends here
+;;; package-tests.el ends here
diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el
index fd998fd..315f25e 100644
--- a/test/lisp/mwheel-tests.el
+++ b/test/lisp/mwheel-tests.el
@@ -24,9 +24,9 @@
(ert-deftest mwheel-test-enable/disable ()
(mouse-wheel-mode 1)
- (should (eq (lookup-key (current-global-map) '[mouse-4]) 'mwheel-scroll))
+ (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event])
'mwheel-scroll))
(mouse-wheel-mode -1)
- (should (eq (lookup-key (current-global-map) '[mouse-4]) nil)))
+ (should (eq (lookup-key (current-global-map) `[,mouse-wheel-up-event]) nil)))
(ert-deftest mwheel-test--create-scroll-keys ()
(should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4)
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 45c9851..8b456c3 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -25,16 +25,25 @@
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
-(defvar dbus--test-enabled-session-bus
+(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
"Check, whether we are registered at the session bus.")
-(defvar dbus--test-enabled-system-bus
+(defconst dbus--test-enabled-system-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :system)))
"Check, whether we are registered at the system bus.")
+(defconst dbus--test-service "org.gnu.Emacs.TestDBus"
+ "Test service.")
+
+(defconst dbus--test-path "/org/gnu/Emacs/TestDBus"
+ "Test object path.")
+
+(defconst dbus--test-interface "org.gnu.Emacs.TestDBus"
+ "Test interface.")
+
(defun dbus--test-availability (bus)
"Test availability of D-Bus BUS."
(should (dbus-list-names bus))
@@ -85,19 +94,19 @@
(defun dbus--test-register-service (bus)
"Check service registration at BUS."
;; Cleanup.
- (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs))
+ (dbus-ignore-errors (dbus-unregister-service bus dbus--test-service))
;; Register an own service.
- (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner))
- (should (member dbus-service-emacs (dbus-list-known-names bus)))
- (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner))
- (should (member dbus-service-emacs (dbus-list-known-names bus)))
+ (should (eq (dbus-register-service bus dbus--test-service) :primary-owner))
+ (should (member dbus--test-service (dbus-list-known-names bus)))
+ (should (eq (dbus-register-service bus dbus--test-service) :already-owner))
+ (should (member dbus--test-service (dbus-list-known-names bus)))
;; Unregister the service.
- (should (eq (dbus-unregister-service bus dbus-service-emacs) :released))
- (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
- (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent))
- (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
+ (should (eq (dbus-unregister-service bus dbus--test-service) :released))
+ (should-not (member dbus--test-service (dbus-list-known-names bus)))
+ (should (eq (dbus-unregister-service bus dbus--test-service) :non-existent))
+ (should-not (member dbus--test-service (dbus-list-known-names bus)))
;; `dbus-service-dbus' is reserved for the BUS itself.
(should-error (dbus-register-service bus dbus-service-dbus))
@@ -106,7 +115,7 @@
(ert-deftest dbus-test02-register-service-session ()
"Check service registration at `:session' bus."
(skip-unless (and dbus--test-enabled-session-bus
- (dbus-register-service :session dbus-service-emacs)))
+ (dbus-register-service :session dbus--test-service)))
(dbus--test-register-service :session)
(let ((service "org.freedesktop.Notifications"))
@@ -124,7 +133,7 @@
(ert-deftest dbus-test02-register-service-system ()
"Check service registration at `:system' bus."
(skip-unless (and dbus--test-enabled-system-bus
- (dbus-register-service :system dbus-service-emacs)))
+ (dbus-register-service :system dbus--test-service)))
(dbus--test-register-service :system))
(ert-deftest dbus-test02-register-service-own-bus ()
@@ -148,7 +157,7 @@ This includes initialization and closing the bus."
(featurep 'dbusbind)
(dbus-init-bus bus)
(dbus-get-unique-name bus)
- (dbus-register-service bus dbus-service-emacs))))
+ (dbus-register-service bus dbus--test-service))))
;; Run the test.
(dbus--test-register-service bus))
@@ -159,19 +168,357 @@ This includes initialization and closing the bus."
"Check `dbus-interface-peer' methods."
(skip-unless
(and dbus--test-enabled-session-bus
- (dbus-register-service :session dbus-service-emacs)
+ (dbus-register-service :session dbus--test-service)
;; "GetMachineId" is not implemented (yet). When it returns a
;; value, another D-Bus client like dbus-monitor is reacting
;; on `dbus-interface-peer'. We cannot test then.
(not
(dbus-ignore-errors
(dbus-call-method
- :session dbus-service-emacs dbus-path-dbus
+ :session dbus--test-service dbus-path-dbus
dbus-interface-peer "GetMachineId" :timeout 100)))))
- (should (dbus-ping :session dbus-service-emacs 100))
- (dbus-unregister-service :session dbus-service-emacs)
- (should-not (dbus-ping :session dbus-service-emacs 100)))
+ (should (dbus-ping :session dbus--test-service 100))
+ (dbus-unregister-service :session dbus--test-service)
+ (should-not (dbus-ping :session dbus--test-service 100)))
+
+(defun dbus--test-method-handler (&rest args)
+ "Method handler for `dbus-test04-register-method'."
+ (cond
+ ;; No argument.
+ ((null args)
+ :ignore)
+ ;; One argument.
+ ((= 1 (length args))
+ (car args))
+ ;; Two arguments.
+ ((= 2 (length args))
+ `(:error ,dbus-error-invalid-args
+ ,(format-message "Wrong arguments %s" args)))
+ ;; More than two arguments.
+ (t (signal 'dbus-error (cons "D-Bus signal" args)))))
+
+(ert-deftest dbus-test04-register-method ()
+ "Check method registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((method "Method")
+ (handler #'dbus--test-method-handler))
+
+ (should
+ (equal
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method handler)
+ `((:method :session ,dbus--test-interface ,method)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; No argument, returns nil.
+ (should-not
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method))
+ ;; One argument, returns the argument.
+ (should
+ (string-equal
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method "foo")
+ "foo"))
+ ;; Two arguments, D-Bus error activated as `(:error ...)' list.
+ (should
+ (equal
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method "foo" "bar"))
+ `(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)")))
+ ;; Three arguments, D-Bus error activated by `dbus-error' signal.
+ (should
+ (equal
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method "foo" "bar" "baz"))
+ `(dbus-error
+ ,dbus-error-failed
+ "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\""))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test05-register-property ()
+ "Check property registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property1 "Property1")
+ (property2 "Property2")
+ (property3 "Property3"))
+
+ ;; Not registered property.
+ (should-not
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1))
+
+ ;; `:read' property.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :read "foo")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property1)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+ (should-not ;; Due to `:read' access type.
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+
+ ;; `:write' property.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 :write "bar")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ (,dbus--test-service ,dbus--test-path))))
+ (should-not ;; Due to `:write' access type.
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 "barbar")
+ "barbar"))
+ (should-not ;; Due to `:write' access type.
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2))
+
+ ;; `:readwrite' property, typed value (Bug#43252).
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3 :readwrite :object-path "/baz")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property3)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3)
+ "/baz"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3 :object-path "/baz/baz")
+ "/baz/baz"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property3)
+ "/baz/baz"))
+
+ ;; `dbus-get-all-properties'. We cannot retrieve a value for
+ ;; the property with `:write' access type.
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should (string-equal (cdr (assoc property1 result)) "foo"))
+ (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
+ (should-not (assoc property2 result)))
+
+ ;; `dbus-get-all-managed-objects'. We cannot retrieve a value for
+ ;; the property with `:write' access type.
+ (let ((result
+ (dbus-get-all-managed-objects
+ :session dbus--test-service dbus--test-path)))
+ (should (setq result (cadr (assoc dbus--test-path result))))
+ (should (setq result (cadr (assoc dbus--test-interface result))))
+ (should (string-equal (cdr (assoc property1 result)) "foo"))
+ (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
+ (should-not (assoc property2 result))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+;; The following test is inspired by Bug#43146.
+(ert-deftest dbus-test05-register-property-several-paths ()
+ "Check property registration for an own service at several paths."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property1 "Property1")
+ (property2 "Property2")
+ (property3 "Property3"))
+
+ ;; First path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :readwrite "foo")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property1)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 :readwrite "bar")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "barbar"))
+
+ ;; Second path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 :readwrite "foo")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 :readwrite "bar")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property3)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "barbar"))
+
+ ;; Everything is still fine, tested with `dbus-get-all-properties'.
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should (string-equal (cdr (assoc property1 result)) "foofoo"))
+ (should (string-equal (cdr (assoc property2 result)) "barbar"))
+ (should-not (assoc property3 result)))
+
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service
+ (concat dbus--test-path dbus--test-path)
dbus--test-interface)))
+ (should (string-equal (cdr (assoc property2 result)) "foofoo"))
+ (should (string-equal (cdr (assoc property3 result)) "barbar"))
+ (should-not (assoc property1 result)))
+
+ ;; Final check with `dbus-get-all-managed-objects'.
+ (let ((result
+ (dbus-get-all-managed-objects :session dbus--test-service "/"))
+ result1)
+ (should (setq result1 (cadr (assoc dbus--test-path result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (string-equal (cdr (assoc property1 result1)) "foofoo"))
+ (should (string-equal (cdr (assoc property2 result1)) "barbar"))
+ (should-not (assoc property3 result1))
+
+ (should
+ (setq
+ result1
+ (cadr (assoc (concat dbus--test-path dbus--test-path) result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (string-equal (cdr (assoc property2 result1)) "foofoo"))
+ (should (string-equal (cdr (assoc property3 result1)) "barbar"))
+ (should-not (assoc property1 result1))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index b549b92..2eaf633 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -31,6 +31,7 @@
(defvar cperl-test-mode #'cperl-mode)
(require 'cperl-mode)
+(require 'ert)
(defvar cperl-mode-tests-data-directory
(expand-file-name "lisp/progmodes/cperl-mode-resources"
@@ -109,11 +110,13 @@ indentation actually takes place.."
(message "%s" (buffer-string)))))
(ert-deftest cperl-mode-test-bug-10483 ()
- "Verifies that a piece of code which ends in a paren without a
-statement terminato ron tne same line does not loop forever. The
-test starts an asynchronous Emacs batch process under timeout
-control."
+ "Check that indenting certain perl code does not loop forever.
+This verifies that indenting a piece of code that ends in a paren
+without a statement terminator on the same line does not loop
+forever. The test starts an asynchronous Emacs batch process
+under timeout control."
(interactive)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
(let* ((emacs (concat invocation-directory invocation-name))
(test-function 'cperl-mode-test--run-bug-10483)
(test-function-name (symbol-name test-function))