[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 6a726c5 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 6a726c5 1/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sun, 13 Sep 2020 12:55:31 -0400 (EDT) |
branch: feature/native-comp
commit 6a726c5ad711ba5224319c6ff8787127a8289c6d
Merge: c55884d 99af480
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
.gitignore | 6 +
configure.ac | 5 +-
doc/emacs/dired.texi | 10 +
doc/emacs/mule.texi | 7 +-
doc/misc/dbus.texi | 11 +-
doc/misc/dired-x.texi | 50 +----
doc/misc/eww.texi | 16 ++
doc/misc/gnus.texi | 4 +-
etc/NEWS | 75 ++++++-
lisp/abbrev.el | 4 +-
lisp/bindings.el | 3 +
lisp/bookmark.el | 6 +-
lisp/calc/calc-comb.el | 12 +-
lisp/calc/calc-funcs.el | 14 +-
lisp/calc/calc.el | 53 +++--
lisp/calc/calcalg3.el | 2 +-
lisp/cedet/semantic.el | 79 +------
lisp/cedet/semantic/bovine/el.el | 1 -
lisp/cedet/semantic/db-mode.el | 4 -
lisp/cedet/semantic/decorate/mode.el | 3 -
lisp/cedet/semantic/doc.el | 3 +-
lisp/cedet/semantic/edit.el | 3 -
lisp/cedet/semantic/fw.el | 13 +-
lisp/cedet/semantic/grammar.el | 2 +-
lisp/cedet/semantic/idle.el | 9 -
lisp/cedet/semantic/imenu.el | 6 -
lisp/cedet/semantic/java.el | 3 -
lisp/cedet/semantic/lex.el | 233 ++-------------------
lisp/cedet/semantic/tag-file.el | 13 --
lisp/cedet/semantic/tag-ls.el | 16 +-
lisp/cedet/semantic/tag.el | 20 --
lisp/cedet/semantic/util.el | 7 -
lisp/cedet/semantic/wisent.el | 5 -
lisp/dired-x.el | 79 +------
lisp/dired.el | 69 +++++-
lisp/emacs-lisp/cl-lib.el | 1 +
lisp/emulation/viper-keym.el | 2 +-
lisp/erc/erc-desktop-notifications.el | 11 +-
lisp/eshell/em-cmpl.el | 3 +
lisp/files.el | 24 +--
lisp/gnus/gnus-agent.el | 1 +
lisp/gnus/gnus-art.el | 5 +-
lisp/gnus/gnus-async.el | 6 -
lisp/gnus/gnus-bookmark.el | 3 +-
lisp/gnus/gnus-group.el | 110 +++++++---
lisp/gnus/gnus-int.el | 42 ++++
lisp/gnus/gnus-score.el | 20 +-
lisp/gnus/gnus-sum.el | 1 +
lisp/gnus/gnus.el | 11 +-
lisp/gnus/message.el | 4 +-
lisp/gnus/nnir.el | 62 ++----
lisp/gnus/nnselect.el | 19 +-
lisp/help-fns.el | 10 +-
lisp/help-mode.el | 2 +-
lisp/international/mule-cmds.el | 18 +-
lisp/international/mule-conf.el | 1 +
lisp/loadup.el | 2 +-
lisp/mail/flow-fill.el | 3 +-
lisp/mail/rmailmm.el | 2 +-
lisp/mail/sendmail.el | 2 +-
lisp/menu-bar.el | 8 +-
lisp/mh-e/mh-comp.el | 3 +-
lisp/minibuf-eldef.el | 2 +-
lisp/misearch.el | 7 +-
lisp/net/dbus.el | 198 ++++++++++-------
lisp/net/eww.el | 53 ++++-
lisp/net/mailcap.el | 14 +-
lisp/obsolete/complete.el | 2 +
lisp/progmodes/cc-defs.el | 9 +
lisp/progmodes/cc-engine.el | 18 +-
lisp/progmodes/cc-mode.el | 59 ++++--
lisp/progmodes/cc-vars.el | 6 +-
lisp/progmodes/cl-font-lock.el | 1 +
lisp/progmodes/etags.el | 4 +-
lisp/simple.el | 27 ++-
lisp/tab-line.el | 3 +-
lisp/textmodes/artist.el | 5 -
lisp/time.el | 4 +-
lisp/vc/diff-mode.el | 18 +-
lisp/vc/diff.el | 12 +-
lisp/vc/ediff-ptch.el | 12 +-
lisp/vc/vc.el | 18 +-
lisp/wid-edit.el | 5 +-
lisp/xml.el | 19 +-
lisp/xwidget.el | 17 +-
src/dbusbind.c | 9 +-
src/fileio.c | 5 +
src/w32term.c | 6 +-
src/xdisp.c | 9 +-
test/Makefile.in | 7 +-
test/lisp/autorevert-tests.el | 3 +
test/lisp/calc/calc-tests.el | 22 +-
test/lisp/cedet/semantic-utest-c.el | 59 +++---
test/lisp/cedet/srecode-utest-getset.el | 1 +
test/lisp/dired-tests.el | 4 +-
test/lisp/emacs-lisp/cl-seq-tests.el | 1 +
test/lisp/emacs-lisp/gv-tests.el | 5 +-
test/lisp/emacs-lisp/package-tests.el | 1 +
test/lisp/filenotify-tests.el | 4 +
test/lisp/gnus/mml-sec-tests.el | 36 +++-
test/lisp/net/dbus-tests.el | 169 ++++++++++++---
test/lisp/net/gnutls-tests.el | 1 +
test/lisp/net/tramp-archive-tests.el | 15 +-
test/lisp/org/org-tests.el | 2 +-
test/lisp/shadowfile-tests.el | 2 +
test/lisp/subr-tests.el | 68 +++---
.../textmodes/css-mode-resources/test-indent.css} | 0
test/lisp/textmodes/css-mode-tests.el | 14 ++
test/lisp/url/url-future-tests.el | 24 ++-
test/lisp/vc/diff-mode-tests.el | 9 +
test/manual/indent/elisp.el | 1 +
test/src/callint-tests.el | 3 +-
test/src/emacs-module-tests.el | 3 +-
113 files changed, 1157 insertions(+), 1061 deletions(-)
diff --git a/.gitignore b/.gitignore
index 0bcd73e..3ef36b4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -165,6 +165,12 @@ GSYMS
GRTAGS
GTAGS
+# auto-generated compilation database
+compile_commands.json
+
+# ccls, a LSP-compliant server for C
+/.ccls-cache
+
# GNU idutils.
ID
diff --git a/configure.ac b/configure.ac
index d6584d9..a3d1d71 100644
--- a/configure.ac
+++ b/configure.ac
@@ -786,10 +786,7 @@ case "${canonical}" in
*-nto-qnx* )
opsys=qnxnto
test -z "$CC" && CC=qcc
- CFLAGS="$CFLAGS -D__NO_EXT_QNX"
- if test "$with_unexec" = yes; then
- LDFLAGS="-N2MB $LDFLAGS"
- fi
+ LDFLAGS="-N2M $LDFLAGS"
;;
## Intel 386 machines where we don't care about the manufacturer.
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 19aaca9..24fd02a 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -109,6 +109,16 @@ the minibuffer (@pxref{Minibuffer History}).
You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
a directory's name.
+@findex dired-jump
+@findex dired-jump-other-window
+@kindex C-x C-j
+@kindex C-x 4 C-j
+ Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a
+Dired buffer and move point to the line corresponding to the current
+file. In Dired, move up a level and go to the previous directory's
+line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the
+same effect but opens a new window for the Dired buffer.
+
The variable @code{dired-listing-switches} specifies the options to
give to @command{ls} for listing the directory; this string
@emph{must} contain @samp{-l}. If you use a prefix argument with the
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 6eff0ca..b780190 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1215,11 +1215,8 @@ system can encode.
If @code{file-name-coding-system} is @code{nil}, Emacs uses a
default coding system determined by the selected language environment,
-and stored in the @code{default-file-name-coding-system} variable.
-@c FIXME? Is this correct? What is the "default language environment"?
-In the default language environment, non-@acronym{ASCII} characters in
-file names are not encoded specially; they appear in the file system
-using the internal Emacs representation.
+and stored in the @code{default-file-name-coding-system} variable
+(normally UTF-8).
@cindex file-name encoding, MS-Windows
@vindex w32-unicode-filenames
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 2880b7f..1d4db7e 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -1471,7 +1471,7 @@ 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)}}.
+@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
@@ -2031,10 +2031,11 @@ This function returns the member name of the D-Bus
object @var{event}
is coming from. It is either a signal name or a method name.
@end defun
-D-Bus errors are not propagated during event handling, because it is
-usually not desired. D-Bus errors in events can be made visible by
-setting the variable @code{dbus-debug} to @code{t}. They can also be
-handled by a hook function.
+@vindex dbus-show-dbus-errors
+D-Bus error messages are not propagated during event handling, because
+it is usually not desired. D-Bus errors in events can be made visible
+by setting the user option @code{dbus-show-dbus-errors} to
+non-@code{nil}. They can also be handled by a hook function.
@defvar dbus-event-error-functions
This hook variable keeps a list of functions, which are called when a
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index d749780..243b59b 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -150,10 +150,8 @@ Commands using file marking
@noindent
@file{dired-x.el} binds some functions to keys in Dired Mode (@pxref{Key
-Index}) and also binds @kbd{C-x C-j} and @kbd{C-x 4 C-j} @emph{globally} to
-@code{dired-jump} (@pxref{Miscellaneous Commands}). Optionally, it
-also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to
-@code{dired-x-find-file} and @code{dired-x-find-file-other-window},
+Index}). Optionally, it also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f}
+to @code{dired-x-find-file} and @code{dired-x-find-file-other-window},
respectively (@pxref{Find File At Point}).
@node Technical Details
@@ -204,32 +202,10 @@ when you first type @kbd{C-x d}).
@ifnottex
@menu
-* Optional Installation Dired Jump::
* Optional Installation File At Point::
@end menu
@end ifnottex
-@node Optional Installation Dired Jump
-@section Optional Installation Dired Jump
-
-@cindex autoloading @code{dired-jump} and @code{dired-jump-other-window}
-
-In order to have @code{dired-jump} and @code{dired-jump-other-window}
-(@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and
-@code{dired-x} have been properly loaded you should set-up an autoload
-for these functions. In your @file{.emacs} file put
-
-@example
-(autoload 'dired-jump "dired-x"
- "Jump to Dired buffer corresponding to current buffer." t)
-
-(autoload 'dired-jump-other-window "dired-x"
- "Like \\[dired-jump] (dired-jump) but in other window." t)
-
-(define-key global-map "\C-x\C-j" 'dired-jump)
-(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)
-@end example
-
@node Optional Installation File At Point
@section Optional Installation File At Point
@@ -919,28 +895,6 @@ inserted subdirectories.
@table @code
-@item dired-jump
-@findex dired-jump
-@kindex C-x C-j
-@cindex jumping to Dired listing containing file.
-Bound to @kbd{C-x C-j}. Jump back to Dired: If in a file, edit the current
-directory and move to file's line. If in Dired already, pop up a level and
-go to old directory's line. In case the proper Dired file line cannot be
-found, refresh the Dired buffer and try again.
-
-@item dired-jump-other-window
-@findex dired-jump-other-window
-@kindex C-x 4 C-j
-Bound to @kbd{C-x 4 C-j}. Like @code{dired-jump}, but to other window.
-
-These functions can be autoloaded so they work even though @file{dired-x.el}
-has not been loaded yet (@pxref{Optional Installation Dired Jump}).
-
-@vindex dired-bind-jump
-If the variable @code{dired-bind-jump} is @code{nil}, @code{dired-jump} will
not be
-bound to @kbd{C-x C-j} and @code{dired-jump-other-window} will not be bound to
-@kbd{C-x 4 C-j}.
-
@item dired-vm
@cindex reading mail.
@kindex V
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 85be112..4ae2c86 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -212,6 +212,22 @@ in an external browser by customizing
@node Advanced
@chapter Advanced
+@findex eww-retrieve-command
+ EWW normally uses @code{url-retrieve} to fetch the @acronym{HTML}
+before rendering it. It can sometimes be convenient to use an
+external program to do this, and @code{eww-retrieve-command} should
+then be a list that specifies a command and the parameters. For
+instance, to use the Chromium browser, you could say something like
+this:
+
+@lisp
+(setq eww-retrieve-command
+ '("chromium" "--headless" "--dump-dom"))
+@end lisp
+
+The command should return the @acronym{HTML} on standard output, and
+the data should use @acronym{UTF-8} as the charset.
+
@findex eww-view-source
@kindex v
@cindex Viewing Source
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 4a09eac..50eeb3e 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -21401,8 +21401,8 @@ be nice.
Gnus has various ways of finding articles that match certain criteria
(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
+to the desired articles using the limiting commands (@pxref{Limiting}),
+or searching through messages in the summary buffer (@pxref{Searching
for Articles}).
Limiting commands and summary buffer searching work on subsets of the
diff --git a/etc/NEWS b/etc/NEWS
index 9d26620..8f10a62 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -86,6 +86,12 @@ useful on systems such as FreeBSD which ships only with
"etc/termcap".
* Changes in Emacs 28.1
+++
+*** Emacs now defaults to UTF-8 instead of ISO-8859-1.
+This is only for the default, where the user has set no LANG (or
+similar) variable or environment. This change should lead to no
+user-visible changes for normal usage.
+
++++
** New variables that hold default buffer names for shell output.
The new constants 'shell-command-buffer-name' and
'shell-command-buffer-name-async' store the default buffer names
@@ -164,6 +170,11 @@ setting the variable 'auto-save-visited-mode'
buffer-locally to nil.
description of the properties. Likewise 'button-describe' does the
same for a button.
+** Obsolete commands are no longer hidden from command completion.
+Completion of command names now considers obsolete aliases as
+candidates. Invoking a command via an obsolete alias now mentions the
+obsolescence fact and shows the new name of the command.
+
* Changes in Specialized Modes and Packages in Emacs 28.1
@@ -290,6 +301,19 @@ details of marking the file at the end of the region.
*** State changing VC operations are supported in Dired on files and
directories with the help of new command 'dired-vc-next-action'.
++++
+*** 'dired-jump' and 'dired-jump-other-window' moved from dired-x to dired.
+The 'dired-jump' and 'dired-jump-other-window' commands have been
+moved from the 'dired-x' package to 'dired'. The user option
+'dired-bind-jump' no longer has any effect and is now obsolete.
+The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default.
+
+To get the old behavior of 'dired-bind-jump' back and unbind the above
+keys, add the following to your Init file:
+
+(global-set-key "\C-x\C-j" nil)
+(global-set-key "\C-x4\C-j" nil)
+
** Change Logs and VC
*** More VC commands can be used from non-file buffers.
@@ -790,6 +814,11 @@ background colors or transparency, such as xbm, pbm, svg,
png and gif.
** EWW
+++
+*** New variable 'eww-retrieve-command'.
+This can be used to download data via an external command. If nil
+(the default), then 'url-retrieve' is used.
+
++++
*** New Emacs command line convenience function.
The 'eww-browse' command has been added, which allows you to register
Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the
@@ -959,14 +988,14 @@ window after starting). This variable defaults to nil.
** Miscellaneous
+++
-*** New command 'submit-emacs-patch'
+*** 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
+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.
@@ -1112,9 +1141,11 @@ type symbols.
+++
*** 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.
+messages, contain the error name of that message now. They can be
+made visible by setting user variable 'dbus-show-dbus-errors' to
+non-nil, even if protected by 'dbus-ignore-errors' otherwise.
* New Modes and Packages in Emacs 28.1
@@ -1210,8 +1241,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'completion-base-size', 'completion-common-substring',
'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit',
'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook',
-'detect-coding-with-priority', 'dirtrack-debug',
-'dirtrack-debug-toggle', 'dynamic-completion-table',
+'define-mode-overload-implementation', 'detect-coding-with-priority',
+'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table',
'easy-menu-precalculate-equivalent-keybindings',
'epa-display-verify-result', 'epg-passphrase-callback-function',
'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark',
@@ -1231,17 +1262,47 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message',
'process-filter-multibyte-p', 'read-file-name-predicate',
'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter',
+'semantic-after-idle-scheduler-reparse-hooks',
+'semantic-after-toplevel-bovinate-hook',
+'semantic-before-idle-scheduler-reparse-hooks',
+'semantic-before-toplevel-bovination-hook',
+'semantic-bovinate-from-nonterminal-full',
+'semantic-bovinate-region-until-error', 'semantic-bovinate-toplevel',
+'semantic-bovination-working-type',
+'semantic-decorate-pending-decoration-hooks',
+'semantic-edits-incremental-reparse-failed-hooks',
+'semantic-eldoc-current-symbol-info', 'semantic-expand-nonterminal',
+'semantic-file-token-stream', 'semantic-find-dependency',
+'semantic-find-nonterminal', 'semantic-flex', 'semantic-flex-buffer',
+'semantic-flex-keyword-get', 'semantic-flex-keyword-p',
+'semantic-flex-keyword-put', 'semantic-flex-keywords',
+'semantic-flex-list', 'semantic-flex-make-keyword-table',
+'semantic-flex-map-keywords', 'semantic-flex-token-end',
+'semantic-flex-token-start', 'semantic-flex-token-text',
+'semantic-imenu-bucketize-type-parts',
+'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token',
+'semantic-init-db-hooks)', 'semantic-init-hooks',
+'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal',
+'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name',
+'semantic-nonterminal-leaf', 'semantic-nonterminal-protection',
+'semantic-something-to-stream', 'semantic-tag-make-assoc-list',
+'semantic-token-type-parent', 'semantic-toplevel-bovine-cache',
+'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks',
'set-coding-priority', 'set-process-filter-multibyte',
'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode',
'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell',
'url-generate-unique-filename', 'url-temporary-directory',
'vc-arch-command', 'vc-default-working-revision' (variable),
'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version',
-'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font'.
+'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
+'wisent-lex-make-token-table'.
* Lisp Changes in Emacs 28.1
+---
+*** 'ascii' is now a coding system alias for 'us-ascii'.
+
+++
*** New function 'file-backup-file-names'.
This function returns the list of file names of all the backup files
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 50d0011..be6f9ee 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -233,7 +233,7 @@ If VERBOSE is non-nil, display a message indicating where
abbrevs
have been saved."
(interactive
(list
- (read-file-name (format-prompt "Write abbrev file" abbrev-file-name)
+ (read-file-name "Write abbrev file: "
(file-name-directory (expand-file-name abbrev-file-name))
abbrev-file-name)))
(or (and file (> (length file) 0))
@@ -262,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 (format-prompt "Save abbrevs to file"
abbrev-file-name)
+ (list (read-file-name "Save abbrevs to file: "
(file-name-directory
(expand-file-name abbrev-file-name))
abbrev-file-name)))
diff --git a/lisp/bindings.el b/lisp/bindings.el
index e3fc563..20342bc 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1383,6 +1383,9 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "'" 'expand-abbrev)
(define-key ctl-x-map "\C-b" 'list-buffers)
+(define-key ctl-x-map "\C-j" 'dired-jump)
+(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)
+
(define-key ctl-x-map "z" 'repeat)
(define-key esc-map "\C-l" 'reposition-window)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 206c872..dcb03ad 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -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-prompt "File to save bookmarks in"
- default)
+ (read-file-name (format "File to save bookmarks in: (%s) "
+ 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-prompt "Load bookmarks from" default)
+ (list (read-file-name (format "Load bookmarks from: (%s) " default)
(file-name-directory default) default 'confirm)
prefix nil prefix)))
(let* ((file (expand-file-name file))
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index c5d4d08..2efeb7f 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -292,15 +292,9 @@
(defconst math-small-factorial-table
(vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
- (math-read-number-simple "479001600")
- (math-read-number-simple "6227020800")
- (math-read-number-simple "87178291200")
- (math-read-number-simple "1307674368000")
- (math-read-number-simple "20922789888000")
- (math-read-number-simple "355687428096000")
- (math-read-number-simple "6402373705728000")
- (math-read-number-simple "121645100408832000")
- (math-read-number-simple "2432902008176640000")))
+ 479001600 6227020800 87178291200 1307674368000 20922789888000
+ 355687428096000 6402373705728000 121645100408832000
+ 2432902008176640000))
(defun calcFunc-fact (n) ; [I I] [F F] [Public]
(let (temp)
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index add39b6..14f5e32 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -816,25 +816,25 @@
(list
(list 'frac
-174611
- (math-read-number-simple "802857662698291200000"))
+ 802857662698291200000)
(list 'frac
43867
- (math-read-number-simple "5109094217170944000"))
+ 5109094217170944000)
(list 'frac
-3617
- (math-read-number-simple "10670622842880000"))
+ 10670622842880000)
(list 'frac
1
- (math-read-number-simple "74724249600"))
+ 74724249600)
(list 'frac
-691
- (math-read-number-simple "1307674368000"))
+ 1307674368000)
(list 'frac
1
- (math-read-number-simple "47900160"))
+ 47900160)
(list 'frac
-1
- (math-read-number-simple "1209600"))
+ 1209600)
(list 'frac
1
30240)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index fb1287b..bf8b006 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1382,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6
(set-keymap-parent map calc-mode-map)
map))
+(defun calc--header-line (long short width &optional fudge)
+ "Return a Calc header line appropriate for the buffer width.
+
+LONG is a desired text for a wide window, SHORT is a desired
+abbreviated text, and width is the buffer width, which will be
+some fraction of the 'parent' window width (At the time of
+writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
+trial-and-error adjustment number for the edge-cases at the
+border of the two cases."
+ ;; TODO: This could be called as part of a 'window-resize' hook.
+ (setq header-line-format
+ (let* ((len-long (length long))
+ (len-short (length short))
+ (fudge (or fudge 0))
+ ;; fudge for trail is: -3 (added to len-long)
+ ;; (width ) for trail
+ (factor (if (> width (+ len-long fudge)) len-long len-short))
+ (size (max (/ (- width factor) 2) 0))
+ (fill (make-string size ?-))
+ (pre (replace-regexp-in-string ".$" " " fill))
+ (post (replace-regexp-in-string "^." " " fill)))
+ (concat pre (if (= factor len-long) long short) post))))
+
(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
"Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
@@ -1396,9 +1419,9 @@ commands given here will actually operate on the
*Calculator* stack."
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (when (= (buffer-size) 0)
- (let ((inhibit-read-only t))
- (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Trail" "Calc Trail"
+ (/ (window-width) 3) -3)))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
@@ -1451,7 +1474,6 @@ commands given here will actually operate on the
*Calculator* stack."
(pop-to-buffer (current-buffer)))))))
(with-current-buffer (calc-trail-buffer)
(and calc-display-trail
- (= (window-width) (frame-width))
(calc-trail-display 1 t)))
(message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for
help, `q' to quit")
(run-hooks 'calc-start-hook)
@@ -1986,13 +2008,11 @@ See calc-keypad for details."
(calc-any-evaltos nil))
(setq calc-any-selections nil)
(erase-buffer)
- (when calc-show-banner
- (insert (propertize "--- Emacs Calculator Mode ---\n"
- 'face 'italic)))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Mode" "Emacs Calc"
+ (* 2 (/ (window-width) 3)) -3))
(while thing
(goto-char (point-min))
- (when calc-show-banner
- (forward-line 1))
(insert (math-format-stack-value (car thing)) "\n")
(setq thing (cdr thing)))
(calc-renumber-stack)
@@ -2076,7 +2096,6 @@ the United States."
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
(goto-char (point-min))
- (forward-line 1)
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
@@ -2144,10 +2163,8 @@ the United States."
(if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
- (if (bobp)
- (forward-line 1)
- (if (eobp)
- (forward-line -1)))
+ (if (eobp)
+ (forward-line -1))
(if (or (bobp) (eobp))
(setq overlay-arrow-position nil) ; trail is empty
(set-marker calc-trail-pointer (point) (current-buffer))
@@ -2161,7 +2178,7 @@ the United States."
(if win
(save-excursion
(forward-line (/ (window-height win) 2))
- (forward-line (- 1 (window-height win)))
+ (forward-line (- 2 (window-height win)))
(set-window-start win (point))
(set-window-point win (+ calc-trail-pointer 4))
(set-buffer calc-main-buffer)
@@ -3435,12 +3452,10 @@ See Info node `(calc)Defining Functions'."
(defun calc-clear-unread-commands ()
(setq unread-command-events nil))
-(defcalcmodevar math-2-word-size
- (math-read-number-simple "4294967296")
+(defcalcmodevar math-2-word-size 4294967296
"Two to the power of `calc-word-size'.")
-(defcalcmodevar math-half-2-word-size
- (math-read-number-simple "2147483648")
+(defcalcmodevar math-half-2-word-size 2147483648
"One-half of two to the power of `calc-word-size'.")
(when calc-always-load-extensions
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index 75e691a..2d38c9c 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -472,7 +472,7 @@
(setq defc (calc-invent-parameter-variables nc defv)))
(let ((vars (read-string (format-prompt
"Fitting variables"
- (format "%s; %s)"
+ (format "%s; %s"
(mapconcat 'symbol-name
(mapcar (function (lambda (v)
(nth 1 v)))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 58a35d7..71321e1 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -82,8 +82,6 @@ introduced."
This variable is for internal use only, and its content depends on the
external parser used.")
(make-variable-buffer-local 'semantic--parse-table)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-table
- 'semantic--parse-table "23.2")
(defvar semantic-symbol->name-assoc-list
'((type . "Types")
@@ -112,17 +110,6 @@ in classes, such as protection labels.")
"Value for `case-fold-search' when parsing.")
(make-variable-buffer-local 'semantic-case-fold)
-(defvar semantic-expand-nonterminal nil
- "Function to call for each nonterminal production.
-Return a list of non-terminals derived from the first argument, or nil
-if it does not need to be expanded.
-Languages with compound definitions should use this function to expand
-from one compound symbol into several. For example, in C the definition
- int a, b;
-is easily parsed into one tag. This function should take this
-compound tag and turn it into two tags, one for A, and the other for B.")
-(make-variable-buffer-local 'semantic-expand-nonterminal)
-
(defvar semantic--buffer-cache nil
"A cache of the fully parsed buffer.
If no significant changes have been made (based on the state) then
@@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you
need the
cached values for some reason, chances are you can add a hook to
`semantic-after-toplevel-cache-change-hook'.")
(make-variable-buffer-local 'semantic--buffer-cache)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache
- 'semantic--buffer-cache "23.2")
(defvar semantic-unmatched-syntax-cache nil
"A cached copy of unmatched syntax tokens.")
@@ -171,18 +156,6 @@ It is called before any request for tags is made via the
function
`semantic-fetch-tags' by an application.
If any hook returns a nil value, the cached value is returned
immediately, even if it is empty.")
-(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook
- 'semantic--before-fetch-tags-hook "23.2")
-
-(defvar semantic-after-toplevel-bovinate-hook nil
- "Hooks run after a toplevel parse.
-It is not run if the toplevel parse command is called, and buffer does
-not need to be fully reparsed.
-For language specific hooks, make sure you define this as a local hook.
-
-This hook should not be used any more.
-Use `semantic-after-toplevel-cache-change-hook' instead.")
-(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2")
(defvar semantic-after-toplevel-cache-change-hook nil
"Hooks run after the buffer tag list has changed.
@@ -305,13 +278,6 @@ This hook is for database functions which intend to swap
in a tag table.
This guarantees that the DB will go before other modes that require
a parse of the buffer.")
-(semantic-varalias-obsolete 'semantic-init-hooks
- 'semantic-init-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-mode-hooks
- 'semantic-init-mode-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-db-hooks
- 'semantic-init-db-hook "23.2")
-
(defsubst semantic-error-if-unparsed ()
"Raise an error if current buffer was not parsed by Semantic."
(unless semantic-new-buffer-fcn-was-run
@@ -516,8 +482,6 @@ is requested."
(semantic-parse-tree-set-needs-rebuild)
;; Remove this hook which tracks if a buffer is up to date or not.
(remove-hook 'after-change-functions 'semantic-change-function t)
- ;; Old model. Delete someday.
- ;;(run-hooks 'semantic-after-toplevel-bovinate-hook)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
semantic--buffer-cache)
@@ -540,17 +504,12 @@ is requested."
(setq semantic--completion-cache nil)
;; Refresh the display of unmatched syntax tokens if enabled
(run-hook-with-args 'semantic-unmatched-syntax-hook
- semantic-unmatched-syntax-cache)
- ;; Old Semantic 1.3 hook API. Maybe useful forever?
- (run-hooks 'semantic-after-toplevel-bovinate-hook)
- )
+ semantic-unmatched-syntax-cache))
(defvar semantic-working-type 'percent
"The type of working message to use when parsing.
'percent means we are doing a linear parse through the buffer.
'dynamic means we are reparsing specific tags.")
-(semantic-varalias-obsolete 'semantic-bovination-working-type
- 'semantic-working-type "23.2")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
"The minimum size of a buffer before working messages are displayed.
@@ -586,8 +545,6 @@ was marked unparseable, then do nothing, and return the
cache."
(semantic-active-p)
;; Application hooks say the buffer is safe for parsing
(run-hook-with-args-until-failure
- 'semantic-before-toplevel-bovination-hook)
- (run-hook-with-args-until-failure
'semantic--before-fetch-tags-hook)
;; If the buffer was previously marked unparseable,
;; then don't waste our time.
@@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing."
;; Return if we are lexically safe
lexically-safe))))
-(defun semantic-bovinate-toplevel (&optional ignored)
- "Backward compatibility function."
- (semantic-fetch-tags))
-(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2")
-
;; Another approach is to let Emacs call the parser on idle time, when
;; needed, use `semantic-fetch-available-tags' to only retrieve
;; available tags, and setup the `semantic-after-*-hook' hooks to
@@ -812,20 +764,6 @@ This function returns semantic tags without overlays."
;; Please move away from these functions, and try using semantic 2.x
;; interfaces instead.
;;
-(defsubst semantic-bovinate-region-until-error
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate between START and END starting with NONTERM.
-Optional DEPTH specifies how many levels of parenthesis to enter.
-This command will parse until an error is encountered, and return
-the list of everything found until that moment.
-This is meant for finding variable definitions at the beginning of
-code blocks in methods. If `bovine-inner-scope' can also support
-commands, use `semantic-bovinate-from-nonterminal-full'."
- (semantic-parse-region start end nonterm depth t))
-(make-obsolete 'semantic-bovinate-region-until-error
- 'semantic-parse-region "23.2")
(defsubst semantic-bovinate-from-nonterminal
(start end nonterm &optional depth length)
@@ -840,21 +778,6 @@ tokens."
(semantic-lex start end (or depth 1) length)
nonterm))))
-(defsubst semantic-bovinate-from-nonterminal-full
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate from within a nonterminal lambda from START to END.
-Iterates until all the space between START and END is exhausted.
-Argument NONTERM is the nonterminal symbol to start with.
-If NONTERM is nil, use `bovine-block-toplevel'.
-Optional argument DEPTH is the depth of lists to dive into.
-When used in a `lambda' of a MATCH-LIST, there is no need to include
-a START and END part."
- (semantic-parse-region start end nonterm (or depth 1)))
-(make-obsolete 'semantic-bovinate-from-nonterminal-full
- 'semantic-parse-region "23.2")
-
;;; User interface
(defun semantic-force-refresh ()
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 656c63b..822ec17 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -420,7 +420,6 @@ Return a bovination list to use."
:parent (symbol-name (nth 2 form))
:documentation (semantic-elisp-do-doc (nth 4 form))
)))
- define-mode-overload-implementation ;; obsoleted
define-mode-local-override
)
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 0ab03ef..16a30b6 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions."
(dolist (elt semanticdb-hooks)
(remove-hook (cadr elt) (car elt)))))
-(semantic-varalias-obsolete 'semanticdb-mode-hooks
- 'global-semanticdb-minor-mode-hook "23.2")
-
-
(defun semanticdb-toggle-global-mode ()
"Toggle use of the Semantic Database feature.
Update the environment of Semantic enabled buffers accordingly."
diff --git a/lisp/cedet/semantic/decorate/mode.el
b/lisp/cedet/semantic/decorate/mode.el
index 8eb6a3b..2936920 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely
flushed."
(defvar semantic-decorate-pending-decoration-hook nil
"Normal hook run to perform pending decoration changes.")
-(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks
- 'semantic-decorate-pending-decoration-hook "23.2")
-
(defun semantic-decorate-add-pending-decoration (fcn &optional buffer)
"Add a pending decoration change represented by FCN.
Applies only to the current BUFFER.
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index 8b39e77..896bc3b 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -93,8 +93,7 @@ just the lexical token and not the string."
Attempt to strip out comment syntactic sugar.
Argument NOSNARF means don't modify the found text.
If NOSNARF is `lex', then return the lex token."
- (let* ((semantic-ignore-comments nil)
- (semantic-lex-analyzer #'semantic-comment-lexer))
+ (let* ((semantic-lex-analyzer #'semantic-comment-lexer))
(if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
(car (semantic-lex (point) (1+ (point))))
(let ((ct (semantic-lex-token-text
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index a1225df..e4319c7 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -121,9 +121,6 @@ incremental reparse.")
"Hook run after the incremental parser fails.
When this happens, the buffer is marked as needing a full reparse.")
-(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks
- 'semantic-edits-incremental-reparse-failed-hook
"23.2")
-
(defcustom semantic-edits-verbose-flag nil
"Non-nil means the incremental parser is verbose.
If nil, errors are still displayed, but informative messages are not."
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index e347c99..c86cd3a 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -173,6 +173,7 @@ Remove self from `post-command-hook' if it is empty."
;;
(defun semantic-overload-symbol-from-function (name)
"Return the symbol for overload used by NAME, the defined symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(let ((sym-name (symbol-name name)))
(if (string-match "^semantic-" sym-name)
(intern (substring sym-name (match-end 0)))
@@ -182,6 +183,7 @@ Remove self from `post-command-hook' if it is empty."
"Make OLDFNALIAS an alias for NEWFN.
Mark OLDFNALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(defalias oldfnalias newfn)
(make-obsolete oldfnalias newfn when)
(when (and (mode-local--function-overload-p newfn)
@@ -196,13 +198,14 @@ will throw a warning when it encounters this symbol."
"%s: `%s' obsoletes overload `%s'"
byte-compile-current-file
newfn
- (semantic-overload-symbol-from-function oldfnalias))
- ))
+ (with-suppressed-warnings ((obsolete
semantic-overload-symbol-from-function))
+ (semantic-overload-symbol-from-function oldfnalias)))))
(defun semantic-varalias-obsolete (oldvaralias newvar when)
"Make OLDVARALIAS an alias for variable NEWVAR.
Mark OLDVARALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-variable-alias "28.1"))
(make-obsolete-variable oldvaralias newvar when)
(condition-case nil
(defvaralias oldvaralias newvar)
@@ -256,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered
(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
-(semantic-alias-obsolete 'define-mode-overload-implementation
- 'define-mode-local-override "23.2")
-
(defun semantic-install-function-overrides (overrides &optional transient)
"Install the function OVERRIDES in the specified environment.
OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD
@@ -396,13 +396,10 @@ into `mode-local-init-hook'." file filename)
;; "define-lex-regex-type-analyzer"
;; "define-lex-string-type-analyzer"
;; "define-lex-block-type-analyzer"
-;; ;;"define-mode-overload-implementation"
;; ;;"define-semantic-child-mode"
;; "define-semantic-idle-service"
;; "define-semantic-decoration-style"
;; "define-wisent-lexer"
-;; "semantic-alias-obsolete"
-;; "semantic-varalias-obsolete"
;; "semantic-make-obsolete-overload"
;; "defcustom-mode-local-semantic-dependency-system-include-path"
;; ))
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 6cd4832..f71ac6c 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments."
"Return expansion of built-in ASSOC expression.
ARGS are ASSOC's key value list."
(let ((key t))
- `(semantic-tag-make-assoc-list
+ `(semantic-tag-make-plist
,@(mapcar #'(lambda (i)
(prog1
(if key
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 7621824..8301b19 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -472,11 +472,6 @@ This hook is not protected from lexical errors.")
If any hook function throws an error, this variable is reset to nil.
This hook is not protected from lexical errors.")
-(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
- 'semantic-before-idle-scheduler-reparse-hook "23.2")
-(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
- 'semantic-after-idle-scheduler-reparse-hook "23.2")
-
(defun semantic-idle-scheduler-refresh-tags ()
"Refreshes the current buffer's tags.
This is called by `semantic-idle-scheduler-function' to update the
@@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode:
(define-overloadable-function semantic-idle-summary-current-symbol-info ()
"Return a string message describing the current context.")
-(make-obsolete-overload 'semantic-eldoc-current-symbol-info
- 'semantic-idle-summary-current-symbol-info
- "23.2")
-
(defcustom semantic-idle-summary-mode-hook nil
"Hook run at the end of `semantic-idle-summary'."
:group 'semantic
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index cdf0a23..25f7fdb 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -88,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is
nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts
- 'semantic-imenu-expand-type-members "23.2")
(defcustom semantic-imenu-bucketize-type-members t
"Non-nil if members of a type should be grouped into buckets.
@@ -98,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts
- 'semantic-imenu-bucketize-type-members "23.2")
(defcustom semantic-imenu-sort-bucket-function nil
"Function to use when sorting tags in the buckets of functions.
@@ -145,8 +141,6 @@ Tags of those classes will be given submenu with children.
By default, a `type' has interesting children. In Texinfo, however, a
`section' has interesting children.")
(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes)
-(semantic-varalias-obsolete 'semantic-imenu-expandable-token
- 'semantic-imenu-expandable-tag-classes "23.2")
;;; Code:
(defun semantic-imenu-tag-overlay (tag)
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index 80d03dc..2aa0ab0 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be
mixed in."
'semantic-format-tag-prototype-default)
tag parent color)))
-(semantic-alias-obsolete 'semantic-java-prototype-nonterminal
- 'semantic-format-tag-prototype-java-mode "23.2")
-
;; Include Tag Name
;;
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 500a09d..3e090c0 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1751,32 +1751,12 @@ If there is no error, then the last value of FORMS is
returned."
))
;;; Compatibility with Semantic 1.x lexical analysis
-;;
-;; NOTE: DELETE THIS SOMEDAY SOON
-
-(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2")
-(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2")
-(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2")
-(semantic-alias-obsolete 'semantic-flex-make-keyword-table
'semantic-lex-make-keyword-table "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p
"23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put
"23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get
"23.2")
-(semantic-alias-obsolete 'semantic-flex-map-keywords
'semantic-lex-map-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2")
-(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2")
-
-;; This simple scanner uses the syntax table to generate a stream of
-;; simple tokens of the form:
-;;
-;; (SYMBOL START . END)
-;;
-;; Where symbol is the type of thing it is. START and END mark that
-;; objects boundary.
(defvar semantic-flex-tokens semantic-lex-tokens
"An alist of semantic token types.
See variable `semantic-lex-tokens'.")
+(make-obsolete-variable 'semantic-flex-tokens
+ 'semantic-lex-tokens "28.1")
(defvar semantic-flex-unterminated-syntax-end-function
(lambda (_syntax _syntax-start flex-end) flex-end)
@@ -1788,6 +1768,8 @@ FLEX-END is where the lexical analysis was asked to end.
This function can be used for languages that can intelligently fix up
broken syntax, or the exit lexical analysis via `throw' or `signal'
when finding unterminated syntax.")
+(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function
+ nil "28.1")
(defvar semantic-flex-extensions nil
"Buffer local extensions to the lexical analyzer.
@@ -1799,6 +1781,7 @@ nil is also a valid return value.
TYPE can be any type of symbol, as long as it doesn't occur as a
nonterminal in the language definition.")
(make-variable-buffer-local 'semantic-flex-extensions)
+(make-obsolete-variable 'semantic-flex-extensions nil "28.1")
(defvar semantic-flex-syntax-modifications nil
"Changes to the syntax table for this buffer.
@@ -1809,237 +1792,47 @@ CHAR is the char passed to `modify-syntax-entry',
and CLASS is the string also passed to `modify-syntax-entry' to define
what syntax class CHAR has.")
(make-variable-buffer-local 'semantic-flex-syntax-modifications)
+(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1")
(defvar semantic-ignore-comments t
"Default comment handling.
The value t means to strip comments when flexing; nil means
to keep comments as part of the token stream.")
(make-variable-buffer-local 'semantic-ignore-comments)
+(make-obsolete-variable 'semantic-ignore-comments nil "28.1")
(defvar semantic-flex-enable-newlines nil
"When flexing, report newlines as syntactic elements.
Useful for languages where the newline is a special case terminator.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-newlines)
+(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1")
(defvar semantic-flex-enable-whitespace nil
"When flexing, report whitespace as syntactic elements.
Useful for languages where the syntax is whitespace dependent.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-whitespace)
+(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1")
(defvar semantic-flex-enable-bol nil
"When flexing, report beginning of lines as syntactic elements.
Useful for languages like python which are indentation sensitive.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-bol)
+(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1")
(defvar semantic-number-expression semantic-lex-number-expression
"See variable `semantic-lex-number-expression'.")
(make-variable-buffer-local 'semantic-number-expression)
+(make-obsolete-variable 'semantic-number-expression
+ 'semantic-lex-number-expression "28.1")
(defvar semantic-flex-depth 0
"Default flexing depth.
This specifies how many lists to create tokens in.")
(make-variable-buffer-local 'semantic-flex-depth)
-
-(defun semantic-flex (start end &optional depth length)
- "Using the syntax table, do something roughly equivalent to flex.
-Semantically check between START and END. Optional argument DEPTH
-indicates at what level to scan over entire lists.
-The return value is a token stream. Each element is a list, such of
-the form (symbol start-expression . end-expression) where SYMBOL
-denotes the token type.
-See `semantic-flex-tokens' variable for details on token types.
-END does not mark the end of the text scanned, only the end of the
-beginning of text scanned. Thus, if a string extends past END, the
-end of the return token will be larger than END. To truly restrict
-scanning, use `narrow-to-region'.
-The last argument, LENGTH specifies that `semantic-flex' should only
-return LENGTH tokens."
- (declare (obsolete define-lex "23.2"))
- (if (not semantic-flex-keywords-obarray)
- (setq semantic-flex-keywords-obarray [ nil ]))
- (let ((ts nil)
- (pos (point))
- (ep nil)
- (curdepth 0)
- (cs (if comment-start-skip
- (concat "\\(\\s<\\|" comment-start-skip "\\)")
- (concat "\\(\\s<\\)")))
- (newsyntax (copy-syntax-table (syntax-table)))
- (mods semantic-flex-syntax-modifications)
- ;; Use the default depth if it is not specified.
- (depth (or depth semantic-flex-depth)))
- ;; Update the syntax table
- (while mods
- (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
- (setq mods (cdr mods)))
- (with-syntax-table newsyntax
- (goto-char start)
- (while (and (< (point) end) (or (not length) (<= (length ts) length)))
- (cond
- ;; catch beginning of lines when needed.
- ;; Must be done before catching any other tokens!
- ((and semantic-flex-enable-bol
- (bolp)
- ;; Just insert a (bol N . N) token in the token stream,
- ;; without moving the point. N is the point at the
- ;; beginning of line.
- (setq ts (cons (cons 'bol (cons (point) (point))) ts))
- nil)) ;; CONTINUE
- ;; special extensions, includes whitespace, nl, etc.
- ((and semantic-flex-extensions
- (let ((fe semantic-flex-extensions)
- (r nil))
- (while fe
- (if (looking-at (car (car fe)))
- (setq ts (cons (funcall (cdr (car fe))) ts)
- r t
- fe nil
- ep (point)))
- (setq fe (cdr fe)))
- (if (and r (not (car ts))) (setq ts (cdr ts)))
- r)))
- ;; catch newlines when needed
- ((looking-at "\\s-*\\(\n\\|\\s>\\)")
- (if semantic-flex-enable-newlines
- (setq ep (match-end 1)
- ts (cons (cons 'newline
- (cons (match-beginning 1) ep))
- ts))))
- ;; catch whitespace when needed
- ((looking-at "\\s-+")
- (if semantic-flex-enable-whitespace
- ;; Language wants whitespaces, link them together.
- (if (eq (car (car ts)) 'whitespace)
- (setcdr (cdr (car ts)) (match-end 0))
- (setq ts (cons (cons 'whitespace
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))))
- ;; numbers
- ((and semantic-number-expression
- (looking-at semantic-number-expression))
- (setq ts (cons (cons 'number
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))
- ;; symbols
- ((looking-at "\\(\\sw\\|\\s_\\)+")
- (setq ts (cons (cons
- ;; Get info on if this is a keyword or not
- (or (semantic-lex-keyword-p (match-string 0))
- 'symbol)
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Character quoting characters (ie, \n as newline)
- ((looking-at "\\s\\+")
- (setq ts (cons (cons 'charquote
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Open parens, or semantic-lists.
- ((looking-at "\\s(")
- (if (or (not depth) (< curdepth depth))
- (progn
- (setq curdepth (1+ curdepth))
- (setq ts (cons (cons 'open-paren
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- (setq ts (cons
- (cons 'semantic-list
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-list 1)
- ;; This case makes flex robust
- ;; to broken lists.
- (error
- (goto-char
- (funcall
-
semantic-flex-unterminated-syntax-end-function
- 'semantic-list
- start end))))
- (setq ep (point)))))
- ts))))
- ;; Close parens
- ((looking-at "\\s)")
- (setq ts (cons (cons 'close-paren
- (cons (match-beginning 0) (match-end 0)))
- ts))
- (setq curdepth (1- curdepth)))
- ;; String initiators
- ((looking-at "\\s\"")
- ;; Zing to the end of this string.
- (setq ts (cons (cons 'string
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-sexp 1)
- ;; This case makes flex
- ;; robust to broken strings.
- (error
- (goto-char
- (funcall
-
semantic-flex-unterminated-syntax-end-function
- 'string
- start end))))
- (setq ep (point)))))
- ts)))
- ;; comments
- ((looking-at cs)
- (if (and semantic-ignore-comments
- (not semantic-flex-enable-whitespace))
- ;; If the language doesn't deal with comments nor
- ;; whitespaces, ignore them here.
- (let ((comment-start-point (point)))
- (forward-comment 1)
- (if (eq (point) comment-start-point)
- ;; In this case our start-skip string failed
- ;; to work properly. Lets try and move over
- ;; whatever white space we matched to begin
- ;; with.
- (skip-syntax-forward "-.'" (point-at-eol))
- ;;(forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1)))
- (if (eq (point) comment-start-point)
- (error "Strange comment syntax prevents lexical analysis"))
- (setq ep (point)))
- (let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
- (save-excursion
- (forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1))
- (setq ep (point)))
- ;; Language wants comments or want them as whitespaces,
- ;; link them together.
- (if (eq (car (car ts)) tk)
- (setcdr (cdr (car ts)) ep)
- (setq ts (cons (cons tk (cons (match-beginning 0) ep))
- ts))))))
- ;; punctuation
- ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
- (setq ts (cons (cons 'punctuation
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; unknown token
- (t
- (error "What is that?")))
- (goto-char (or ep (match-end 0)))
- (setq ep nil)))
- ;; maybe catch the last beginning of line when needed
- (and semantic-flex-enable-bol
- (= (point) end)
- (bolp)
- (setq ts (cons (cons 'bol (cons (point) (point))) ts)))
- (goto-char pos)
- ;;(message "Flexing muscles...done")
- (nreverse ts)))
+(make-obsolete-variable 'semantic-flex-depth nil "28.1")
(provide 'semantic/lex)
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 50d43fe..23f4b29 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object."
)
)
-(make-obsolete-overload 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
;;; Dependencies
;;
;; A tag which is of type 'include specifies a dependency.
@@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for
searching. Always searches
nil)
)))
-(make-obsolete-overload 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
;;; PROTOTYPE FILE
;;
;; In C, a function in the .c file often has a representation in a
@@ -199,13 +193,6 @@ file prototypes belong in."
(if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
(match-string 1))))))
-(semantic-alias-obsolete 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
-(semantic-alias-obsolete 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
-
(provide 'semantic/tag-file)
;; Local variables:
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 16179a5..3ee11df 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details."
;; will contain the info needed to determine the full name.
(define-overloadable-function semantic-tag-full-package (tag &optional
stream-or-buffer)
"Return the fully qualified package name of TAG in a package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by
`semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in
STREAM."
(define-overloadable-function semantic-tag-full-name (tag &optional
stream-or-buffer)
"Return the fully qualified name of TAG in the package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by
`semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is
present."
(or stream-or-buffer tag))))
(:override-with-args (tag stream))))
-(make-obsolete-overload 'semantic-nonterminal-full-name
- 'semantic-tag-full-name "23.2")
-
(defun semantic-tag-full-name-default (tag stream)
"Default method for `semantic-tag-full-name'.
Return the name of TAG found in the toplevel STREAM."
@@ -287,9 +284,6 @@ is to return a symbol based on type modifiers."
(setq parent (semantic-tag-calculate-parent tag)))
(:override))
-(make-obsolete-overload 'semantic-nonterminal-protection
- 'semantic-tag-protection "23.2")
-
(defun semantic-tag-protection-default (tag &optional parent)
"Return the protection of TAG as a child of PARENT default action.
See `semantic-tag-protection'."
@@ -377,9 +371,6 @@ in how methods are overridden. In UML, abstract methods
are italicized.
The default behavior (if not overridden with `tag-abstract-p'
is to return true if `abstract' is in the type modifiers.")
-(make-obsolete-overload 'semantic-nonterminal-abstract
- 'semantic-tag-abstract-p "23.2")
-
(defun semantic-tag-abstract-p-default (tag &optional parent)
"Return non-nil if TAG is abstract as a child of PARENT default action.
See `semantic-tag-abstract-p'."
@@ -400,9 +391,6 @@ In UML, leaf methods and classes have special meaning and
behavior.
The default behavior (if not overridden with `tag-leaf-p'
is to return true if `leaf' is in the type modifiers.")
-(make-obsolete-overload 'semantic-nonterminal-leaf
- 'semantic-tag-leaf-p "23.2")
-
(defun semantic-tag-leaf-p-default (tag &optional parent)
"Return non-nil if TAG is leaf as a child of PARENT default action.
See `semantic-tag-leaf-p'."
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index ca5c068..e677264 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1328,26 +1328,6 @@ This function is overridable with the symbol
`insert-foreign-tag'."
(defconst semantic-token-incompatible-version
semantic-tag-incompatible-version)
-(defsubst semantic-token-type-parent (tag)
- "Return the parent of the type that TAG describes.
-The return value is a list. A value of nil means no parents.
-The `car' of the list is either the parent class, or a list
-of parent classes. The `cdr' of the list is the list of
-interfaces, or abstract classes which are parents of TAG."
- (cons (semantic-tag-get-attribute tag :superclasses)
- (semantic-tag-type-interfaces tag)))
-
-(make-obsolete 'semantic-token-type-parent
- "\
-use `semantic-tag-type-superclass' \
-and `semantic-tag-type-interfaces' instead" "23.2")
-
-(semantic-alias-obsolete 'semantic-tag-make-assoc-list
- 'semantic-tag-make-plist "23.2")
-
-(semantic-varalias-obsolete 'semantic-expand-nonterminal
- 'semantic-tag-expand-function "23.2")
-
(provide 'semantic/tag)
;; Local variables:
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index c64d56b..7df7dfc 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find
the file
(with-current-buffer (find-file-noselect file)
(semantic-fetch-tags))))))
-(semantic-alias-obsolete 'semantic-file-token-stream
- 'semantic-file-tag-table "23.2")
-
(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t)
(declare-function semanticdb-refresh-table "semantic/db")
(declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t)
@@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil."
;; don't know what it is
(t nil)))
-(semantic-alias-obsolete 'semantic-something-to-stream
- 'semantic-something-to-tag-table "23.2")
-
;;; Completion APIs
;;
;; These functions provide minibuffer reading/completion for lists of
@@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point."
semantic-init-db-hook
semantic-unmatched-syntax-hook
semantic--before-fetch-tags-hook
- semantic-after-toplevel-bovinate-hook
semantic-after-toplevel-cache-change-hook
semantic-before-toplevel-cache-flush-hook
semantic-dump-parse
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 527a35c..15d1313 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -43,11 +43,6 @@
"Extra lookahead token.
When non-nil it is directly returned by `wisent-lex-function'.")
-;; Maintain this alias for compatibility until all WY grammars have
-;; been translated again to Elisp code.
-(semantic-alias-obsolete 'wisent-lex-make-token-table
- 'semantic-lex-make-type-table "23.2")
-
(defmacro wisent-lex-eoi ()
"Return an End-Of-Input lexical token.
The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)."
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 80a266f..b09ef90 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way."
:type 'boolean
:group 'dired-keys)
-(defcustom dired-bind-jump t
- "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not.
-Setting this variable directly after dired-x is loaded has no effect -
-use \\[customize]."
- :type 'boolean
- :set (lambda (sym val)
- (if (set sym val)
- (progn
- (define-key ctl-x-map "\C-j" 'dired-jump)
- (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window))
- (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j"))
- (define-key ctl-x-map "\C-j" nil))
- (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j"))
- (define-key ctl-x-4-map "\C-j" nil))))
- :group 'dired-keys)
+(defvar dired-bind-jump t)
+(make-obsolete-variable 'dired-bind-jump "not used." "28.1")
(defcustom dired-bind-man t
"Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not.
@@ -308,7 +295,6 @@ To see the options you can set, use M-x customize-group RET
dired-x RET.
See also the functions:
`dired-flag-extension'
`dired-virtual'
- `dired-jump'
`dired-man'
`dired-vm'
`dired-rmail'
@@ -446,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions',
dired-bibtex-unclean-extensions
dired-tex-unclean-extensions
(list ".dvi"))))
-
-(defvar archive-superior-buffer)
-(defvar tar-superior-buffer)
-;;; JUMP.
-;;;###autoload
-(defun dired-jump (&optional other-window file-name)
- "Jump to Dired buffer corresponding to current buffer.
-If in a file, Dired the current directory and move to file's line.
-If in Dired already, pop up a level and goto old directory's line.
-In case the proper Dired file line cannot be found, refresh the dired
-buffer and try again.
-When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
-When FILE-NAME is non-nil, jump to its line in Dired.
-Interactively with prefix argument, read FILE-NAME."
- (interactive
- (list nil (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (cond
- ((and (bound-and-true-p archive-subfile-mode)
- (buffer-live-p archive-superior-buffer))
- (switch-to-buffer archive-superior-buffer))
- ((and (bound-and-true-p tar-subfile-mode)
- (buffer-live-p tar-superior-buffer))
- (switch-to-buffer tar-superior-buffer))
- (t
- ;; Expand file-name before `dired-goto-file' call:
- ;; `dired-goto-file' requires its argument to be an absolute
- ;; file name; the result of `read-file-name' could be
- ;; an abbreviated file name (Bug#24409).
- (let* ((file (or (and file-name (expand-file-name file-name))
- buffer-file-name))
- (dir (if file (file-name-directory file) default-directory)))
- (if (and (eq major-mode 'dired-mode) (null file-name))
- (progn
- (setq dir (dired-current-directory))
- (dired-up-directory other-window)
- (unless (dired-goto-file dir)
- ;; refresh and try again
- (dired-insert-subdir (file-name-directory dir))
- (dired-goto-file dir)))
- (if other-window
- (dired-other-window dir)
- (dired dir))
- (if file
- (or (dired-goto-file file)
- ;; refresh and try again
- (progn
- (dired-insert-subdir (file-name-directory file))
- (dired-goto-file file))
- ;; Toggle omitting, if it is on, and try again.
- (when dired-omit-mode
- (dired-omit-mode)
- (dired-goto-file file)))))))))
-
-;;;###autoload
-(defun dired-jump-other-window (&optional file-name)
- "Like \\[dired-jump] (`dired-jump') but in other window."
- (interactive
- (list (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (dired-jump t file-name))
;;; OMITTING.
diff --git a/lisp/dired.el b/lisp/dired.el
index 733d83e..15592ce 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -896,9 +896,8 @@ 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-prompt "Dired %s(directory)"
- default-directory str)
- nil default-directory)))))
+ (read-file-name (format "Dired %s(directory): " str)
+ nil default-directory nil)))))
;; We want to switch to a more sophisticated version of
;; dired-read-dir-and-switches like the following, if there is a way
@@ -4476,6 +4475,70 @@ Ask means pop up a menu for the user to select one of
copy, move or link."
(add-to-list 'desktop-buffer-mode-handlers
'(dired-mode . dired-restore-desktop-buffer))
+
+;;;; Jump to Dired
+
+(defvar archive-superior-buffer)
+(defvar tar-superior-buffer)
+
+;;;###autoload
+(defun dired-jump (&optional other-window file-name)
+ "Jump to Dired buffer corresponding to current buffer.
+If in a file, Dired the current directory and move to file's line.
+If in Dired already, pop up a level and goto old directory's line.
+In case the proper Dired file line cannot be found, refresh the dired
+buffer and try again.
+When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
+When FILE-NAME is non-nil, jump to its line in Dired.
+Interactively with prefix argument, read FILE-NAME."
+ (interactive
+ (list nil (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (cond
+ ((and (bound-and-true-p archive-subfile-mode)
+ (buffer-live-p archive-superior-buffer))
+ (switch-to-buffer archive-superior-buffer))
+ ((and (bound-and-true-p tar-subfile-mode)
+ (buffer-live-p tar-superior-buffer))
+ (switch-to-buffer tar-superior-buffer))
+ (t
+ ;; Expand file-name before `dired-goto-file' call:
+ ;; `dired-goto-file' requires its argument to be an absolute
+ ;; file name; the result of `read-file-name' could be
+ ;; an abbreviated file name (Bug#24409).
+ (let* ((file (or (and file-name (expand-file-name file-name))
+ buffer-file-name))
+ (dir (if file (file-name-directory file) default-directory)))
+ (if (and (eq major-mode 'dired-mode) (null file-name))
+ (progn
+ (setq dir (dired-current-directory))
+ (dired-up-directory other-window)
+ (unless (dired-goto-file dir)
+ ;; refresh and try again
+ (dired-insert-subdir (file-name-directory dir))
+ (dired-goto-file dir)))
+ (if other-window
+ (dired-other-window dir)
+ (dired dir))
+ (if file
+ (or (dired-goto-file file)
+ ;; refresh and try again
+ (progn
+ (dired-insert-subdir (file-name-directory file))
+ (dired-goto-file file))
+ ;; Toggle omitting, if it is on, and try again.
+ (when (bound-and-true-p dired-omit-mode)
+ (dired-omit-mode)
+ (dired-goto-file file)))))))))
+
+;;;###autoload
+(defun dired-jump-other-window (&optional file-name)
+ "Like \\[dired-jump] (`dired-jump') but in other window."
+ (interactive
+ (list (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (dired-jump t file-name))
+
(provide 'dired)
(run-hooks 'dired-load-hook) ; for your customizations
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7a4d3c9..86ee94e 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -663,6 +663,7 @@ This can be needed when using code byte-compiled using the
old
macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects."
:global t
+ :group 'tools
(cond
(cl-old-struct-compat-mode
(advice-add 'type-of :around #'cl--old-struct-type-of))
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 1b149b1..d76cf71 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta."
:type 'string
:group 'viper)
-(defconst viper-ESC-key [escape]
+(defconst viper-ESC-key (kbd "ESC")
"Key used to ESC.")
diff --git a/lisp/erc/erc-desktop-notifications.el
b/lisp/erc/erc-desktop-notifications.el
index 1e65f8f..3a9a4a4 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -31,6 +31,7 @@
(require 'erc)
(require 'xml)
(require 'notifications)
+(require 'erc-goodies)
(require 'erc-match)
(require 'dbus)
@@ -62,12 +63,12 @@ This will replace the last notification sent with this
function."
;; setting the current buffer to the existing query buffer)
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (let ((channel (if privp (erc-get-buffer nick) (current-buffer))))
+ (let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
+ (title (format "%s in %s" (xml-escape-string nick t) channel))
+ (body (xml-escape-string (erc-controls-strip msg) t)))
(notifications-notify :bus erc-notifications-bus
- :title (format "%s in %s"
- (xml-escape-string nick)
- channel)
- :body (xml-escape-string msg)
+ :title title
+ :body body
:replaces-id
erc-notifications-last-notification
:app-icon erc-notifications-icon
:actions '("default" "Switch to buffer")
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index dcf56af..8a444c9 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -116,6 +116,9 @@ is non-nil."
(defcustom eshell-command-completions-alist
'(("acroread" . "\\.pdf\\'")
("xpdf" . "\\.pdf\\'")
+ ("gunzip" . "\\.t?gz\\'")
+ ("bunzip2" . "\\.t?bz2\\'")
+ ("unxz" . "\\.t?xz\\'")
("ar" . "\\.[ao]\\'")
("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
diff --git a/lisp/files.el b/lisp/files.el
index 61e7e21..92ae072 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4530,12 +4530,13 @@ Interactively, confirmation is required unless you
supply a prefix argument."
;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
- (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)))
+ (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))
(not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
@@ -5273,13 +5274,10 @@ 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* ((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))))
+ (let ((filename
+ (expand-file-name
+ (read-file-name "File to save in: "
+ nil (expand-file-name
(buffer-name))))))
(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/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 03e447e..d7388d4 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -3812,6 +3812,7 @@ has been fetched."
t))))
(defun gnus-agent-store-article (article group)
+ (declare (obsolete nil "28.1"))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(file (gnus-agent-article-name (number-to-string article) group))
(file-name-coding-system nnmail-pathname-coding-system)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e0339cc..13a8537 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -7084,10 +7084,7 @@ If given a prefix, show the hidden text instead."
gnus-summary-buffer)
(when gnus-keep-backlog
(gnus-backlog-enter-article
- group article (current-buffer)))
- (when (and gnus-agent
- (gnus-agent-group-covered-p group))
- (gnus-agent-store-article article group)))
+ group article (current-buffer))))
(setq result 'article))
(methods
(setq gnus-override-method (pop methods)))
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index e3e81c8..9bcb6c3 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -225,12 +225,6 @@ that was fetched."
(save-excursion
(save-restriction
(narrow-to-region mark (point-max))
- ;; Put the articles into the agent, if they aren't already.
- (when (and gnus-agent
- (gnus-agent-group-covered-p group))
- (save-restriction
- (narrow-to-region mark (point-max))
- (gnus-agent-store-article article group)))
;; Prefetch images for the groups that want that.
(when (fboundp 'gnus-html-prefetch-images)
(gnus-html-prefetch-images summary))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 7e96843..1b00bbb 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -315,7 +315,8 @@ affect point."
"Load Gnus bookmarks from FILE (which must be in bookmark format)."
(interactive
(list (read-file-name
- (format-prompt "Load Gnus bookmarks from" gnus-bookmark-default-file)
+ (format "Load Gnus bookmarks from: (%s) "
+ 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-group.el b/lisp/gnus/gnus-group.el
index fcaa6d7..1d614f8 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3166,30 +3166,67 @@ mail messages or news articles in files that have
numeric names."
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-(autoload 'nnir-make-specs "nnir")
+(autoload 'nnir-read-parms "nnir")
+(autoload 'nnir-server-to-search-engine "nnir")
(autoload 'gnus-group-topic-name "gnus-topic")
;; Temporary to make group creation easier
(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+ "Make a 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")
(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
- (list
- (cons 'nnselect-function 'nnir-run-query)
- (cons 'nnselect-args
- (nnir-make-specs nnir-extra-parms specs)))))))))
+ (let* ((group-spec
+ (or
+ (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr
+ (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or
+ (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))))
(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.
+ "Read 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
@@ -3200,19 +3237,42 @@ 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
- (list
- (cons 'nnselect-specs
- (list
- (cons 'nnselect-function 'nnir-run-query)
- (cons 'nnselect-args
- (nnir-make-specs nnir-extra-parms specs))))
- (cons 'nnselect-artlist nil))))
+ (let* ((group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr
+ (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index da385a1..b8be766 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -365,6 +365,48 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method 'request-list)
(nth 1 gnus-command-method)))
+(defun gnus-server-get-active (server &optional ignored)
+ "Return the active list for SERVER.
+Groups matching the IGNORED regexp are excluded."
+ (let ((method (gnus-server-to-method server))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null ignored)
+ (string= ignored ""))
+ (delete-matching-lines ignored))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method)
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method)))
+ groups))
+ (forward-line)))))
+ groups))
+
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
"Read and update infos from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index c5156a1..ffc6b8c 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -862,6 +862,18 @@ If optional argument `EXTRA' is non-nil, it's a
non-standard overview header."
(setq match (string-to-number match)))
(set-text-properties 0 (length match) nil match))
+ ;; Modify match and type for article age scoring.
+ (if (string= "date" (nth 0 (assoc header gnus-header-index)))
+ (let ((age (string-to-number match)))
+ (if (or (< age 0)
+ (string= "0" match))
+ (user-error "Article age must be a positive number"))
+ (setq match age
+ type (cond ((eq type 'after)
+ '<)
+ ((eq type 'before)
+ '>)))))
+
(unless (eq date 'now)
;; Add the score entry to the score file.
(when (= score gnus-score-interactive-default-score)
@@ -1695,9 +1707,10 @@ score in `gnus-newsgroup-scored' by SCORE."
match (gnus-date-iso8601 (nth 0 kill))))
((eq type '<)
(setq type 'after
- match-func 'gnus-string>
+ match-func 'string<
match (gnus-time-iso8601
- (time-add (current-time) (* 86400 (nth 0 kill))))))
+ (time-subtract (current-time)
+ (* 86400 (nth 0 kill))))))
((eq type 'before)
(setq match-func 'gnus-string>
match (gnus-date-iso8601 (nth 0 kill))))
@@ -1705,7 +1718,8 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq type 'before
match-func 'gnus-string>
match (gnus-time-iso8601
- (time-add (current-time) (* -86400 (nth 0 kill))))))
+ (time-subtract (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-sum.el b/lisp/gnus/gnus-sum.el
index 45397b5..2f0ea0c 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -10708,6 +10708,7 @@ groups."
;; We only have to update this line.
(save-excursion
(save-restriction
+ (nnheader-ms-strip-cr)
(message-narrow-to-head)
(let ((head (buffer-substring-no-properties
(point-min) (point-max)))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 6216a9a..ab54286 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3628,11 +3628,12 @@ If you call this function inside a loop, consider using
the faster
(defun gnus-group-get-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters.
-If ALLOW-LIST, also allow list as a result.
-Most functions should use `gnus-group-find-parameter', which
-also examines the topic parameters."
- (let ((params (gnus-info-params (gnus-get-info group))))
+If SYMBOL, return the value of that symbol in the group
+parameters. If ALLOW-LIST, also allow list as a result. Most
+functions should use `gnus-group-find-parameter', which also
+examines the topic parameters. GROUP can also be an info structure."
+ (let ((params (gnus-info-params (if (listp group) group
+ (gnus-get-info group)))))
(if symbol
(gnus-group-parameter-value params symbol allow-list)
params)))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index e103224..3e7e189 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3536,8 +3536,8 @@ Prefix arg means justify as well."
(equal quoted (match-string 0)))
(goto-char (match-end 0))
(looking-at "[ \t]*")
- (if (> (length leading-space) (length (match-string 0)))
- (setq leading-space (match-string 0)))
+ (when (< (length leading-space) (length (match-string 0)))
+ (setq leading-space (match-string 0)))
(forward-line 1))
(setq end (point))
(goto-char beg)
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index c46903a..168c994 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -549,6 +549,7 @@ construct the vector entries."
;;; Search Engine Interfaces:
+(autoload 'gnus-server-get-active "gnus-int")
(autoload 'nnimap-change-group "nnimap")
(declare-function nnimap-buffer "nnimap" ())
(declare-function nnimap-command "nnimap" (&rest args))
@@ -567,7 +568,8 @@ extensions."
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
(gnus-inhibit-demon t)
- (groups (or groups (nnir-get-active srv))))
+ (groups
+ (or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
(message "Opening server %s" server)
(apply
'vconcat
@@ -1205,7 +1207,8 @@ construct path: search terms (see the variable
(directory (cadr (assoc sym (cddr method))))
(regexp (cdr (assoc 'query query)))
(grep-options (cdr (assoc 'grep-options query)))
- (grouplist (or grouplist (nnir-get-active server))))
+ (grouplist
+ (or grouplist (gnus-server-get-active server
nnir-ignored-newsgroups))))
(unless directory
(error "No directory found in method specification of server %s"
server))
@@ -1332,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil."
((and (not not-global) (boundp key)) (symbol-value key))
(t nil))))
-(autoload 'gnus-request-list "gnus-int")
-
-(defun nnir-get-active (srv)
- "Return the active list for SRV."
- (let ((method (gnus-server-to-method srv))
- groups)
- (gnus-request-list method)
- (with-current-buffer nntp-server-buffer
- (let ((cur (current-buffer)))
- (goto-char (point-min))
- (unless (or (null nnir-ignored-newsgroups)
- (string= nnir-ignored-newsgroups ""))
- (delete-matching-lines nnir-ignored-newsgroups))
- (if (eq (car method) 'nntp)
- (while (not (eobp))
- (ignore-errors
- (push (gnus-group-full-name
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
- method)
- groups))
- (forward-line))
- (while (not (eobp))
- (ignore-errors
- (push (if (eq (char-after) ?\")
- (gnus-group-full-name (read cur) method)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- (gnus-group-full-name name method)))
- groups))
- (forward-line)))))
- groups))
-
-(autoload 'nnselect-categorize "nnselect" nil nil)
(autoload 'gnus-group-topic-name "gnus-topic" nil nil)
(defvar gnus-group-marked)
(defvar gnus-topic-alist)
+(make-obsolete 'nnir-make-specs "This function should no longer
+be used." "28.1")
+
(defun nnir-make-specs (nnir-extra-parms &optional specs)
"Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS.
Query for the specs, or use SPECS."
@@ -1387,12 +1349,12 @@ Query for the specs, or use SPECS."
(or (cdr (assq 'nnir-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
- (nnselect-categorize
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
- (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
- 'nnselect-group-server))))
+ (cdr (assoc (gnus-group-topic-name)
gnus-topic-alist))))))))
(query-spec
(or (cdr (assq 'nnir-query-spec specs))
(apply
@@ -1407,6 +1369,8 @@ Query for the specs, or use SPECS."
(list (cons 'nnir-query-spec query-spec)
(cons 'nnir-group-spec group-spec))))
+(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active
"28.1")
+
;; The end.
(provide 'nnir)
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 4916286..94dd93b 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -105,9 +105,7 @@
(gnus-uncompress-sequence artseq)) selection)))
selection)))
-(defun nnselect-group-server (group)
- "Return the server for GROUP."
- (gnus-group-server group))
+(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
;; Data type article list.
@@ -418,6 +416,21 @@ If this variable is nil, or if the provided function
returns nil,
to-newsgroup ; Not respooling
(gnus-group-real-name to-newsgroup)))))
+(deffoo nnselect-request-replace-article
+ (article _group buffer &optional no-encode)
+ (pcase-let ((`[,artgroup ,artnumber ,artrsv]
+ (with-current-buffer gnus-summary-buffer
+ (nnselect-artlist-article gnus-newsgroup-selection article))))
+ (unless (gnus-check-backend-function
+ 'request-replace-article artgroup)
+ (user-error "The group %s does not support article editing" artgroup))
+ (let ((newart
+ (gnus-request-replace-article artnumber artgroup buffer no-encode)))
+ (with-current-buffer gnus-summary-buffer
+ (cl-nsubstitute `[,artgroup ,newart ,artrsv]
+ `[,artgroup ,artnumber ,artrsv]
+ gnus-newsgroup-selection
+ :test #'equal :count 1)))))
(deffoo nnselect-request-expire-articles
(articles _group &optional _server force)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index fe0af3c..5cb1c5e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1820,9 +1820,8 @@ 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 (format-prompt "Name of DOC file"
- internal-doc-file-name)
- doc-directory internal-doc-file-name t)))
+ (interactive (list (read-file-name "Name of DOC file: " 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*"))
@@ -1851,9 +1850,8 @@ 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 (format-prompt "Name of DOC file"
- internal-doc-file-name)
- doc-directory internal-doc-file-name t)))
+ (interactive (list (read-file-name "Name of DOC file: " 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-mode.el b/lisp/help-mode.el
index 9c2d1d7..0dc6c9f 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function
(lambda (file pos)
- (pop-to-buffer (find-file-noselect file))
+ (view-buffer-other-window (find-file-noselect file))
(goto-char pos))
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index ccc8ac9..e3155df 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1799,13 +1799,11 @@ The default status is as follows:
'raw-text)
(set-default-coding-systems nil)
- (setq default-sendmail-coding-system 'iso-latin-1)
- ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded
- ;; that is not yet defined, so we set it in set-locale-environment instead.
- ;; [Actually, it seems to work fine to use utf-8-unix here, and not just
- ;; on Darwin. The previous comment seems to be outdated?
- ;; See patch at https://debbugs.gnu.org/15803 ]
- (setq default-file-name-coding-system 'iso-latin-1-unix)
+ (setq default-sendmail-coding-system 'utf-8)
+ (setq default-file-name-coding-system (if (memq system-type
+ '(window-nt ms-dos))
+ 'iso-latin-1-unix
+ 'utf-8-unix))
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
@@ -1821,8 +1819,10 @@ The default status is as follows:
(input-coding
(condition-case nil
(coding-system-change-text-conversion
- (cdr default-process-coding-system) 'iso-latin-1)
- (coding-system-error 'iso-latin-1))))
+ (cdr default-process-coding-system)
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8))
+ (coding-system-error
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8)))))
(setq default-process-coding-system
(cons output-coding input-coding)))
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index edda79b..c84f0a4 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc."
:mime-charset 'us-ascii)
(define-coding-system-alias 'iso-safe 'us-ascii)
+(define-coding-system-alias 'ascii 'us-ascii)
(define-coding-system 'utf-7
"UTF-7 encoding of Unicode (RFC 2152)."
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 5718477..f218ec1 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -170,7 +170,6 @@
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
-(load "button")
;; We don't want to store loaddefs.el in the repository because it is
;; a generated file; but it is required in order to compile the lisp files.
@@ -193,6 +192,7 @@
definition-prefixes)
(setq definition-prefixes new))
+(load "button") ;After loaddefs, because of define-minor-mode!
(load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded")
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index f4b5503..b357b3e 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -157,7 +157,8 @@ lines."
;; Hack: Don't do the flowing on the signature line.
(when (and (not (looking-at "-- $"))
(eq (char-before (line-end-position)) ?\s))
- (while (eq (char-before (line-end-position)) ?\s)
+ (while (and (not (eobp))
+ (eq (char-before (line-end-position)) ?\s))
(end-of-line)
(when delete-space
(delete-char -1))
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 0b9af82..29c6dcf 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-prompt "Save as" filename)
+ (read-file-name (format "Save as (default: %s): " filename)
directory
(expand-file-name filename directory))
directory))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index dd6eecb..7610939 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -975,7 +975,7 @@ but lower priority than the local value of
`buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
;;;###autoload
-(defvar default-sendmail-coding-system 'iso-latin-1
+(defvar default-sendmail-coding-system 'utf-8
"Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index bc094c9..9a93fa6 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -536,6 +536,12 @@
(if (featurep 'ns)
(bindings--define-key menu [separator-undo] menu-bar-separator))
+ (bindings--define-key menu [undo-redo]
+ '(menu-item "Redo" undo-redo
+ :enable (and (not buffer-read-only)
+ (undo--last-change-was-undo-p buffer-undo-list))
+ :help "Redo last undone edits"))
+
(bindings--define-key menu [undo]
'(menu-item "Undo" undo
:enable (and (not buffer-read-only)
@@ -543,7 +549,7 @@
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
- :help "Undo last operation"))
+ :help "Undo last edits"))
menu))
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index f7e30bf..8a69adb 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -305,6 +305,7 @@ message and scan line."
(let ((draft-buffer (current-buffer))
(file-name buffer-file-name)
(config mh-previous-window-config)
+ ;; FIXME this is subtly different to select-message-coding-system.
(coding-system-for-write
(if (fboundp 'select-message-coding-system)
(select-message-coding-system) ; Emacs has this since at least
21.1
@@ -318,7 +319,7 @@ message and scan line."
(or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
(and (default-boundp 'buffer-file-coding-system)
(default-value 'buffer-file-coding-system))
- 'iso-latin-1)))))
+ 'utf-8)))))
;; Older versions of spost do not support -msgid and -mime.
(unless mh-send-uses-spost-flag
;; Adding a Message-ID field looks good, makes it easier to search for
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index a32d21a..6cd8580 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -48,7 +48,7 @@
(regexp-quote (substring minibuffer-default-prompt-format
(match-end 0))))
(regexp-quote minibuffer-default-prompt-format))
- ": *\\)")
+ "\\): ")
1)
`(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 7796df4..958c10a 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -316,10 +316,9 @@ 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
- (format-prompt "First file to search: "
- (file-name-nondirectory
buffer-file-name))
- default-directory buffer-file-name)))
+ (let* ((files (list (read-file-name "First file to search: "
+ default-directory
+ buffer-file-name)))
(file nil))
(while (not (string-equal
(setq file (read-file-name
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 5afc7f1..d4e6cb9 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -55,6 +55,9 @@
;;; D-Bus constants.
+(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
+ "D-Bus compound types, represented as list.")
+
(defconst dbus-service-dbus "org.freedesktop.DBus"
"The bus name used to talk to the bus itself.")
@@ -151,6 +154,17 @@ See URL
`https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;;; Default D-Bus errors.
+(defgroup dbus nil
+ "Elisp bindings for D-Bus."
+ :group 'comm
+ :link '(custom-manual "(dbus)Top")
+ :version "28.1")
+
+(defcustom dbus-show-dbus-errors nil
+ "Propagate incoming D-Bus error messages."
+ :version "28.1"
+ :type 'boolean)
+
(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
"The namespace for default error names.
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
@@ -164,6 +178,9 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
"Invalid arguments passed to a method call.")
+(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply")
+ "No reply to a message expecting one, usually means a timeout occurred.")
+
(defconst dbus-error-property-read-only
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
@@ -183,6 +200,7 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
;;; Emacs defaults.
+
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
@@ -199,11 +217,17 @@ shall be subdirectories of this path.")
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
-Otherwise, return result of last form in BODY, or all other errors."
+Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil
+and a D-Bus error message has arrived. Otherwise, return result
+of last form in BODY, or all other errors."
(declare (indent 0) (debug t))
`(condition-case err
(progn ,@body)
- (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
+ (dbus-error
+ (when (or dbus-debug
+ (and dbus-show-dbus-errors
+ (= dbus-message-type-error (nth 2 last-input-event))))
+ (signal (car err) (cdr err))))))
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler.
@@ -348,23 +372,24 @@ object is returned instead of a list containing this
single Lisp object.
(puthash key result dbus-return-values-table)
(unwind-protect
- (progn
- (with-timeout ((if timeout (/ timeout 1000.0) 25)
- (signal 'dbus-error (list "call timed out")))
- (while (eq (car result) :pending)
- (let ((event (let ((inhibit-redisplay t) unread-command-events)
- (read-event nil nil check-interval))))
- (when event
- (if (ignore-errors (dbus-check-event event))
- (setf result (gethash key dbus-return-values-table))
- (setf unread-command-events
- (nconc unread-command-events
- (cons event nil)))))
- (when (< check-interval 1)
- (setf check-interval (* check-interval 1.05))))))
- (when (eq (car result) :error)
- (signal (cadr result) (cddr result)))
- (cdr result))
+ (progn
+ (with-timeout
+ ((if timeout (/ timeout 1000.0) 25)
+ (signal 'dbus-error `(,dbus-error-no-reply "Call timed out")))
+ (while (eq (car result) :pending)
+ (let ((event (let ((inhibit-redisplay t) unread-command-events)
+ (read-event nil nil check-interval))))
+ (when event
+ (if (ignore-errors (dbus-check-event event))
+ (setf result (gethash key dbus-return-values-table))
+ (setf unread-command-events
+ (nconc unread-command-events
+ (cons event nil)))))
+ (when (< check-interval 1)
+ (setf check-interval (* check-interval 1.05))))))
+ (when (eq (car result) :error)
+ (signal (cadr result) (cddr result)))
+ (cdr result))
(remhash key dbus-return-values-table))))
(defun dbus-call-method-asynchronously
@@ -409,7 +434,7 @@ Example:
\(dbus-call-method-asynchronously
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
- \"org.freedesktop.Hal.Device\" \"GetPropertyString\" \\='message
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message
\"system.kernel.machine\")
-| i686
@@ -689,7 +714,7 @@ Example:
\(dbus-register-signal
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
- \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" \\='my-signal-handler)
+ \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler)
=> ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
my-signal-handler))
@@ -901,16 +926,19 @@ association to the service from D-Bus."
(progn
(maphash
(lambda (k v)
- (dolist (e v)
- (ignore-errors
- (and
- ;; Bus.
- (equal bus (cadr k))
- ;; Service.
- (string-equal service (cadr e))
- ;; Non-empty object path.
- (nth 2 e)
- (throw :found t)))))
+ (when (consp v)
+ (dolist (e v)
+ (ignore-errors
+ (and
+ ;; Type.
+ (eq type (car k))
+ ;; Bus.
+ (equal bus (cadr k))
+ ;; Service.
+ (string-equal service (cadr e))
+ ;; Non-empty object path.
+ (nth 2 e)
+ (throw :found t))))))
dbus-registered-objects-table)
nil))))
(dbus-unregister-service bus service))
@@ -1454,20 +1482,19 @@ valid D-Bus value, or nil if there is no PROPERTY, or
PROPERTY cannot be read."
(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. VALUE can be preceded
-by a TYPE symbol. When the value is successfully set return
-VALUE. Otherwise, return nil.
+by a TYPE symbol. When the value is successfully set, and the
+property's access type is not `:write', 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 (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))))))
+ "Set" :timeout 500 interface property (list :variant args))
+ ;; Return VALUE.
+ (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.
@@ -1543,13 +1570,15 @@ 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)))
+ (let ((signature "s") ;; FIXME: For the time being.
+ ;; Read basic type symbol.
+ (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
+ (unless (or type (consp value))
(setq type
(cond
((memq value '(t nil)) :boolean)
@@ -1559,6 +1588,8 @@ clients from discovering the still incomplete interface.
((stringp value) :string)
(t
(signal 'wrong-type-argument (list "Value type invalid"
value))))))
+ (unless (consp value)
+ (setq value (list type value)))
;; Add handlers for the three property-related methods.
(dbus-register-method
@@ -1579,12 +1610,14 @@ clients from discovering the still incomplete interface.
(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}"))
+ ;; changed_properties.
+ (if (eq access :write)
+ '(:array: :signature "{sv}")
+ `(:array
+ (:dict-entry
+ ,property
+ ,(if type (list :variant type value) (list :variant value)))))
+ ;; invalidated_properties.
(if (eq access :write)
`(:array ,property)
'(:array))))
@@ -1595,10 +1628,7 @@ clients from discovering the still incomplete interface.
(val
(cons
(list
- nil service path
- (cons
- (if emits-signal (list access :emits-signal) (list access))
- (if type (list type value) (list value))))
+ nil service path (list access emits-signal signature value))
(dbus-get-other-registered-properties
bus service path interface property))))
(puthash key val dbus-registered-objects-table)
@@ -1626,16 +1656,19 @@ It will be registered for all objects created by
`dbus-register-property'."
`(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
- ((memq :write (car object))
+ ((eq :write (car object))
`(:error ,dbus-error-access-denied
,(format-message
"Property \"%s\" at path \"%s\" is not readable" property path)))
- ;; Return the result.
- (t (list :variant (cdar (last (car entry))))))))
+ ;; Return the result. Since variant is a list, we must embed
+ ;; it into another list.
+ (t (list (if (memq (car (nth 3 object)) dbus-compound-types)
+ (list :variant (nth 3 object))
+ (cons :variant (nth 3 object))))))))
- ;; "Set" expects a variant.
+ ;; "Set" expects the same type as registered. FIXME: Implement!
((string-equal method "Set")
- (let* ((value (caar (cddr args)))
+ (let* ((value (caar (nth 2 args)))
(entry (dbus-get-this-registered-property
bus service path interface property))
(object (car (last (car entry)))))
@@ -1644,27 +1677,30 @@ It will be registered for all objects created by
`dbus-register-property'."
`(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
- ((memq :read (car object))
+ ((eq :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)
+ (t (unless (consp value)
+ (setq value (list (car (nth 3 object)) value)))
+ (puthash (list :property bus interface property)
(cons (append
(butlast (car entry))
- ;; Reuse ACCESS und TYPE from registration.
- (list (list (car object) (cadr object) value)))
+ ;; Reuse ACCESS, EMITS-SIGNAL and TYPE.
+ (list (append (butlast object) (list value))))
(dbus-get-other-registered-properties
bus service path interface property))
dbus-registered-objects-table)
;; Send the "PropertiesChanged" signal.
- (when (member :emits-signal (car object))
+ (when (nth 1 object)
(dbus-send-signal
bus service path dbus-interface-properties "PropertiesChanged"
- (if (or (member :read (car object))
- (member :readwrite (car object)))
- `(:array (:dict-entry ,property (:variant ,value)))
- '(:array: :signature "{sv}"))
- (if (eq (car object) :write)
+ ;; changed_properties.
+ (if (eq :write (car object))
+ '(:array: :signature "{sv}")
+ `(:array (:dict-entry ,property (:variant ,value))))
+ ;; invalidated_properties.
+ (if (eq :write (car object))
`(:array ,property)
'(:array))))
;; Return empty reply.
@@ -1677,18 +1713,22 @@ It will be registered for all objects created by
`dbus-register-property'."
(lambda (key val)
(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)))))
+ (let ((object (car (last item))))
+ (when (and (equal (butlast key) (list :property bus interface))
+ (string-equal path (nth 2 item))
+ (consp object)
+ (not (eq :write (car object))))
+ (push
+ (list :dict-entry
+ (car (last key))
+ (if (memq (car (nth 3 object)) dbus-compound-types)
+ (list :variant (nth 3 object))
+ (cons :variant (nth 3 object))))
+ result))))))
dbus-registered-objects-table)
- ;; Return the result, or an empty array.
- (list :array (or result '(:signature "{sv}")))))
+ ;; Return the result, or an empty array. An array must be
+ ;; embedded in a list.
+ (list (cons :array (or result '(:signature "{sv}"))))))
(t `(:error ,dbus-error-unknown-method
,(format-message
@@ -1896,9 +1936,13 @@ this connection to those buses."
;;; TODO:
+;; * Check property type in org.freedesktop.DBus.Properties.Set.
+;;
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
+;; * Implement org.freedesktop.DBus.Monitoring.BecomeMonitor.
+;;
;; * Cache introspection data.
;;
;; * Run handlers in own threads.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 07aa48a..69dc2d4 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -134,6 +134,15 @@ The string will be passed through
`substitute-command-keys'."
:type '(choice (const :tag "Unlimited" nil)
integer))
+(defcustom eww-retrieve-command nil
+ "Command to retrieve an URL via an external program.
+If nil, `url-retrieve' is used to download the data. If non-nil,
+this should be a list where the first item is the program, and
+the rest are the arguments."
+ :version "28.1"
+ :type '(choice (const :tag "Use `url-retrieve'" nil)
+ (list string)))
+
(defcustom eww-use-external-browser-for-content-type
"\\`\\(video/\\|audio/\\|application/ogg\\)"
"Always use external browser for specified content-type."
@@ -346,9 +355,34 @@ killed after rendering."
(let ((eww-buffer (current-buffer)))
(with-current-buffer buffer
(eww-render nil url nil eww-buffer)))
- (url-retrieve url #'eww-render
+ (eww-retrieve url #'eww-render
(list url nil (current-buffer))))))
+(defun eww-retrieve (url callback cbargs)
+ (if (null eww-retrieve-command)
+ (url-retrieve url #'eww-render
+ (list url nil (current-buffer)))
+ (let ((buffer (generate-new-buffer " *eww retrieve*"))
+ (error-buffer (generate-new-buffer " *eww error*")))
+ (with-current-buffer buffer
+ (set-buffer-multibyte nil)
+ (make-process
+ :name "*eww fetch*"
+ :buffer (current-buffer)
+ :stderr error-buffer
+ :command (append eww-retrieve-command (list url))
+ :sentinel (lambda (process _)
+ (unless (process-live-p process)
+ (when (buffer-live-p error-buffer)
+ (when (get-buffer-process error-buffer)
+ (delete-process (get-buffer-process error-buffer) ))
+ (kill-buffer error-buffer))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (insert "Content-type: text/html;
charset=utf-8\n\n")
+ (apply #'funcall callback nil cbargs))))))))))
+
(function-put 'eww 'browse-url-browser-kind 'internal)
(defun eww--dwim-expand-url (url)
@@ -695,14 +729,15 @@ Currently this means either text/html or
application/xhtml+xml."
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
- (let ((title (propertize (plist-get eww-data :title)
- 'face 'variable-pitch))
- (peer (plist-get eww-data :peer))
+ (let ((peer (plist-get eww-data :peer))
(url (propertize (plist-get eww-data :url)
- 'face 'variable-pitch)))
- (when (zerop (length title))
- (setq title (propertize "[untitled]" 'face 'variable-pitch)))
- ;; This connection has is https.
+ 'face 'variable-pitch))
+ (title (propertize
+ (if (zerop (length (plist-get eww-data :title)))
+ "[untitled]"
+ (plist-get eww-data :title))
+ 'face 'variable-pitch)))
+ ;; This connection is https.
(when peer
(add-face-text-property 0 (length title)
(if (plist-get peer :warnings)
@@ -1117,7 +1152,7 @@ just re-display the HTML already fetched."
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url #'eww-render
+ (eww-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))
;; Form support.
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index f01a5de..94cd9e2 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1133,11 +1133,15 @@ For instance, \"foo.png\" will result in \"image/png\"."
`mailcap--computed-mime-data' determines the method to use."
(let ((method (mailcap-mime-info type)))
(if (stringp method)
- (shell-command-on-region (point-min) (point-max)
- ;; Use stdin as the "%s".
- (format method "-")
- (current-buffer)
- t)
+ (let ((file (make-temp-file "emacs-mailcap" nil
+ (cadr (split-string type "/")))))
+ (unwind-protect
+ (let ((coding-system-for-write 'binary))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (delete-region (point-min) (point-max))
+ (shell-command (format method file)))
+ (when (file-exists-p file)
+ (delete-file file))))
(funcall method))))
(provide 'mailcap)
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index bf16fb2..b1448e7 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -431,6 +431,8 @@ of `minibuffer-completion-table' and the minibuffer
contents.")
(let ((result (try-completion string alist predicate)))
(if (eq result t) string result)))
+(defvar completion-base-size)
+
;; TODO document MODE magic...
(defun PC-do-completion (&optional mode beg end goto-end)
"Internal function to do the work of partial completion.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 9a3d7ad..77e263f 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -434,6 +434,15 @@ to it is returned. This function does not modify the
point or the mark."
(setq count (+ count (skip-chars-backward "\\\\"))))
(not (zerop (logand count 1))))))
+(defmacro c-will-be-unescaped (beg end)
+ ;; Would the character after END be unescaped after the removal of (BEG END)?
+ ;; This is regardless of its current status. It is assumed that (>= POS
END).
+ `(save-excursion
+ (let (count)
+ (goto-char ,beg)
+ (setq count (skip-chars-backward "\\\\"))
+ (zerop (logand count 1)))))
+
(defvar c-use-extents)
(defmacro c-next-single-property-change (position prop &optional object limit)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 7ff424c..7d10027 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2238,7 +2238,7 @@ comment at the start of cc-engine.el for more info."
((and c-opt-cpp-prefix
(looking-at c-noise-macro-name-re))
- ;; Skip over a noise macro.
+ ;; Skip over a noise macro without parens.
(goto-char (match-end 1))
(not (eobp)))
@@ -9130,6 +9130,12 @@ This function might do hidden buffer changes."
(catch 'is-function
(while
(progn
+ (while
+ (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((looking-at
c-noise-macro-with-parens-name-re)
+ (c-forward-noise-clause))))
(if (eq (char-after) ?\))
(throw 'is-function t))
(setq cdd-got-type (c-forward-type))
@@ -9782,6 +9788,16 @@ This function might do hidden buffer changes."
(save-excursion
(goto-char after-paren-pos)
(c-forward-syntactic-ws)
+ (progn
+ (while
+ (cond
+ ((and
+ c-opt-cpp-prefix
+ (looking-at
c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))))
+ t)
(or (c-forward-type)
;; Recognize a top-level typeless
;; function declaration in C.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2ffbde9..c6dd671 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1478,9 +1478,11 @@ Note that the style variables are always made local to
the buffer."
(c-will-be-escaped end beg end))
(c-remove-string-fences end)
(goto-char (1+ end)))
- ;; Are we unescaping a newline by inserting stuff between \ and \n?
- ((and (eq end beg)
- (c-is-escaped end))
+ ;; Are we unescaping a newline ...
+ ((and
+ (c-is-escaped end)
+ (or (eq beg end) ; .... by inserting stuff between \ and \n?
+ (c-will-be-unescaped beg end))) ; ... by removing an odd
number of \s?
(goto-char (1+ end))) ; To after the NL which is being unescaped.
(t
(goto-char end)))
@@ -1518,10 +1520,11 @@ Note that the style variables are always made local to
the buffer."
(not (c-characterp c-multiline-string-start-char))))
(when (and (eq end-literal-type 'string)
(not (eq (char-before (cdr end-limits)) ?\())
- (memq (char-after (car end-limits)) c-string-delims)
- (equal (c-get-char-property (car end-limits) 'syntax-table)
- '(15)))
- (c-remove-string-fences (car end-limits))
+ (memq (char-after (car end-limits)) c-string-delims))
+ (setq c-new-END (max c-new-END (cdr end-limits)))
+ (when (equal (c-get-char-property (car end-limits) 'syntax-table)
+ '(15))
+ (c-remove-string-fences (car end-limits)))
(setq c-new-END (max c-new-END (cdr end-limits))))
(when (and (eq beg-literal-type 'string)
@@ -1594,8 +1597,12 @@ Note that the style variables are always made local to
the buffer."
; insertion/deletion of string delimiters.
(max
(progn
- (goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
- (point-max)))
+ (goto-char
+ (if (and (memq (char-after end) '(?\n ?\r))
+ (c-is-escaped end))
+ (min (1+ end) ; 1+, if we're inside an escaped NL.
+ (point-max))
+ end))
(re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t)
(point))
@@ -2259,7 +2266,8 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(defun c-fl-decl-end (pos)
;; If POS is inside a declarator, return the end of the token that follows
;; the declarator, otherwise return nil. POS being in a literal does not
- ;; count as being in a declarator (on pragmatic grounds).
+ ;; count as being in a declarator (on pragmatic grounds). POINT is not
+ ;; preserved.
(goto-char pos)
(let ((lit-start (c-literal-start))
enclosing-attribute pos1)
@@ -2272,12 +2280,31 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(let ((lim (save-excursion
(and (c-beginning-of-macro)
(progn (c-end-of-macro) (point))))))
- (when (and (c-forward-declarator lim)
- (or (not (eq (char-after) ?\())
- (c-go-list-forward nil lim))
- (eq (c-forward-token-2 1 nil lim) 0))
- (c-backward-syntactic-ws)
- (point)))))))
+ (and (c-forward-declarator lim)
+ (if (eq (char-after) ?\()
+ (and
+ (c-go-list-forward nil lim)
+ (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (progn
+ (if (looking-at c-symbol-char-key)
+ ;; Deal with baz (foo((bar)) type var), where
+ ;; foo((bar)) is not semantically valid. The result
+ ;; must be after var).
+ (and
+ (goto-char pos)
+ (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\())
+ (c-fl-decl-end (1- (point))))
+ (c-backward-syntactic-ws)
+ (point))))
+ (and (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (c-backward-syntactic-ws)
+ (point)))))))))
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index b885f6a..9e6f952 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1670,7 +1670,8 @@ indented as a statement."
like \"INLINE\" which are syntactic noise. Such a macro/extension is complete
in itself, never having parentheses. All these names must be syntactically
valid identifiers. Alternatively, this variable may be a regular expression
-which matches the names of such macros.
+which matches the names of such macros, in which case it must have a submatch
+1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
@@ -1686,7 +1687,8 @@ this implicitly by reinitializing C/C++/Objc Mode on any
buffer)."
which optionally have arguments in parentheses, and which expand to nothing.
All these names must be syntactically valid identifiers. These are recognized
by CC Mode only in declarations. Alternatively, this variable may be a
-regular expression which matches the names of such macros.
+regular expression which matches the names of such macros, in which case it
+must have a submatch 1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el
index 7ef43fd..65090ac 100644
--- a/lisp/progmodes/cl-font-lock.el
+++ b/lisp/progmodes/cl-font-lock.el
@@ -277,6 +277,7 @@
(define-minor-mode cl-font-lock-built-in-mode
"Highlight built-in functions, variables, and types in `lisp-mode'."
:global t
+ :group 'tools
(funcall
(if cl-font-lock-built-in-mode
#'font-lock-add-keywords
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 81cb2b7..2c5c365 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
- (format-prompt "Visit tags table" "TAGS")
+ "Visit tags table (default 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 (format-prompt "Visit tags table" "TAGS")
+ (read-file-name "Visit tags table (default TAGS): "
default-directory
"TAGS"
t))))))
diff --git a/lisp/simple.el b/lisp/simple.el
index 3b2b5c9..b00f6bb 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1881,22 +1881,20 @@ to get different commands to edit and resubmit."
'(metadata
(annotation-function . read-extended-command--annotation)
(category . command))
- (let ((pred
- (if (memq action '(nil t))
- ;; Exclude obsolete commands from completions.
- (lambda (sym)
- (and (funcall pred sym)
- (or (equal string (symbol-name sym))
- (not (get sym 'byte-obsolete-info)))))
- pred)))
- (complete-with-action action obarray string pred))))
+ (complete-with-action action obarray string pred)))
#'commandp t nil 'extended-command-history)))
(defun read-extended-command--annotation (command-name)
- (let* ((function (and (stringp command-name) (intern-soft command-name)))
- (binding (where-is-internal function overriding-local-map t)))
- (when (and binding (not (stringp binding)))
- (format " (%s)" (key-description binding)))))
+ (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+ (binding (where-is-internal fun overriding-local-map t))
+ (obsolete (get fun 'byte-obsolete-info))
+ (alias (symbol-function fun)))
+ (cond ((symbolp alias)
+ (format " (%s)" alias))
+ (obsolete
+ (format " (%s)" (car obsolete)))
+ ((and binding (not (stringp binding)))
+ (format " (%s)" (key-description binding))))))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
@@ -2752,7 +2750,8 @@ Contrary to `undo', this will not redo a previous undo."
(let ((undo-no-redo t)) (undo arg)))
(defun undo-redo (&optional arg)
- "Undo the last ARG undos."
+ "Undo the last ARG undos, i.e., redo the last ARG changes.
+Interactively, ARG is the prefix numeric argument and defaults to 1."
(interactive "*p")
(cond
((not (undo--last-change-was-undo-p buffer-undo-list))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 108f9f7..8da554a 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -646,7 +646,8 @@ using the `previous-buffer' command."
"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."
+last tab switches to the first tab. This variable is not consulted
+when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'."
:type 'boolean
:group 'tab-line
:version "28.1")
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 9f08772..9c94fff 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -115,8 +115,6 @@
;;; Requirements:
-;; Artist requires Emacs 19.28 or higher.
-;;
;; Artist requires the `rect' package (which comes with Emacs) to be
;; loadable, unless the variable `artist-interface-with-rect' is set
;; to nil.
@@ -127,9 +125,6 @@
;;; Known bugs:
-;; The shifted operations are not available when drawing with the mouse
-;; in Emacs 19.29 and 19.30.
-;;
;; It is not possible to change between shifted and unshifted operation
;; while drawing with the mouse. (See the comment in the function
;; artist-shift-has-changed for further details.)
diff --git a/lisp/time.el b/lisp/time.el
index 534f128..e2fab4a 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -551,9 +551,9 @@ See `world-clock'."
(delete-char -1))
(goto-char (point-min)))
-;; Old name -- preserved for backwards compatibility.
;;;###autoload
-(defalias 'display-time-world #'world-clock)
+(define-obsolete-function-alias 'display-time-world
+ #'world-clock "28.1")
;;;###autoload
(defun world-clock ()
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index a1fdd11..f223ae4 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -911,11 +911,10 @@ 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))
- (default (diff-find-file-name old 'noprompt)))
+ (fs (diff-hunk-file-names current-prefix-arg)))
(unless fs (error "No file name to look for"))
- (list old (read-file-name (format-prompt "File for %s" default (car fs))
- nil default t))))
+ (list old (read-file-name (format "File for %s: " (car fs))
+ nil (diff-find-file-name old 'noprompt) 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)))
@@ -931,8 +930,12 @@ If the OLD prefix arg is passed, tell the file NAME of the
old file."
(progn (diff-hunk-prev) (point))
(error (point-min)))))
(header-files
- ;; handle filenames with spaces;
+ ;; handle file names with spaces;
;; cf. diff-font-lock-keywords / diff-file-header
+ ;; FIXME if there are nonascii characters in the file names,
+ ;; GNU diff displays them as octal escapes.
+ ;; This function should undo that, so as to return file names
+ ;; that are usable in Emacs.
(if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+]
\\([^\t\n]+\\)")
(list (if old (match-string 1) (match-string 2))
(if old (match-string 2) (match-string 1)))
@@ -2170,9 +2173,10 @@ Return new point, if it was moved."
(smerge-refine-regions beg-del beg-add beg-add end-add
nil #'diff-refine-preproc props-r
props-a)))))
('context
- (let* ((middle (save-excursion (re-search-forward "^---" end)))
+ (let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (while (and middle
+ (re-search-forward "^\\(?:!.*\n\\)+" middle t))
(smerge-refine-regions (match-beginning 0) (match-end 0)
(save-excursion
(goto-char other)
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 9e7e771..4698880 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -145,9 +145,17 @@ Possible values are:
(defun diff-no-select (old new &optional switches no-async buf)
;; Noninteractive helper for creating and reverting diff buffers
- "Compare the OLD and NEW file/buffer, and return a diff buffer.
+ "Compare the OLD and NEW file/buffer.
+If the optional SWITCHES is nil, the switches specified in the
+variable ‘diff-switches’ are passed to the diff command,
+otherwise SWITCHES is used. SWITCHES can be a string or a list
+of strings.
-See `diff' for the meaning of the arguments."
+If NO-ASYNC is non-nil, call diff synchronously.
+
+By default, this function creates the diff in the \"*Diff*\"
+buffer. If BUF is non-nil, BUF is used instead. This function
+returns the buffer used."
(unless (bufferp new) (setq new (expand-file-name new)))
(unless (bufferp old) (setq old (expand-file-name old)))
(or switches (setq switches diff-switches)) ; If not specified, use default.
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 8b12209..f6af5a4 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -499,11 +499,15 @@ are two possible targets for this %spatch. However,
these files do not exist."
patch-file-name)
(setq patch-file-name
(read-file-name
- (format-prompt "Patch is in file"
- (and buffer-file-name
+ (format "Patch is in file%s: "
+ (cond ((and buffer-file-name
(equal (expand-file-name dir)
- (file-name-directory buffer-file-name))
- (file-name-nondirectory buffer-file-name)))
+ (file-name-directory buffer-file-name)))
+ (concat
+ " (default "
+ (file-name-nondirectory buffer-file-name)
+ ")"))
+ (t "")))
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/vc.el b/lisp/vc/vc.el
index 983fb59..4cbd265 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -953,9 +953,10 @@ use."
;; repository, make sure it's a parent of
;; file.
(read-file-name
- (format-prompt "create %s repository in" def-dir bk)
+ (format "create %s repository in: " 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))
@@ -2899,10 +2900,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 (let ((default (when (vc-backend buffer-file-name)
- buffer-file-name)))
- (read-file-name "VC delete file" default)
- nil default t)))
+ (interactive (list (read-file-name "VC delete file: " nil
+ (when (vc-backend buffer-file-name)
+ buffer-file-name)
+ t)))
(setq file (expand-file-name file))
(let ((buf (get-file-buffer file))
(backend (vc-backend file)))
@@ -2943,10 +2944,9 @@ 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 (let ((default (when (vc-backend buffer-file-name)
- buffer-file-name)))
- (read-file-name (format-prompt "VC rename file" default)
- nil default t))
+ (interactive (list (read-file-name "VC rename file: " nil
+ (when (vc-backend buffer-file-name)
+ buffer-file-name) 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/wid-edit.el b/lisp/wid-edit.el
index e9799dc..bc2afc6 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3162,8 +3162,9 @@ It reads a file name from an editable text field."
#'completion-file-name-table
(not read-file-name-completion-ignore-case))
:match (lambda (widget value)
- (or (not (widget-get widget :must-match))
- (file-exists-p value)))
+ (and (stringp value)
+ (or (not (widget-get widget :must-match))
+ (file-exists-p value))))
:validate (lambda (widget)
(let ((value (widget-value widget)))
(unless (widget-apply widget :match value)
diff --git a/lisp/xml.el b/lisp/xml.el
index 10ef8e2..236d9cb 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -1015,7 +1015,10 @@ The first line is indented with the optional
INDENT-STRING."
(defalias 'xml-print 'xml-debug-print)
-(defun xml-escape-string (string)
+(defconst xml-invalid-characters-re
+ "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]")
+
+(defun xml-escape-string (string &optional noerror)
"Convert STRING into a string containing valid XML character data.
Replace occurrences of &<>\\='\" in STRING with their default XML
entity references (e.g., replace each & with &).
@@ -1026,15 +1029,17 @@ restriction on \" or \\=', but we just substitute for
these too
\(as is permitted by the spec).
If STRING contains characters that are invalid in XML (as defined
-by https://www.w3.org/TR/xml/#charsets), signal an error of type
-`xml-invalid-character'."
+by https://www.w3.org/TR/xml/#charsets), operate depending on the
+value of NOERROR: if it is non-nil, remove them; else, signal an
+error of type `xml-invalid-character'."
(with-temp-buffer
(insert string)
(goto-char (point-min))
- (when (re-search-forward
-
"[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]"
- nil t)
- (signal 'xml-invalid-character (list (char-before) (match-beginning 0))))
+ (while (re-search-forward xml-invalid-characters-re nil t)
+ (if noerror
+ (replace-match "")
+ (signal 'xml-invalid-character
+ (list (char-before) (match-beginning 0)))))
(dolist (substitution '(("&" . "&")
("<" . "<")
(">" . ">")
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index d6ca300..0743208 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -326,15 +326,14 @@ 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* ((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)))
+ (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)))))
(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 af294af..02af244 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1824,10 +1824,11 @@ SERVICE PATH OBJECT [RULE]) ...). SERVICE is the
service name as
registered, UNAME is the corresponding unique name. In case of
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 list containing the value of the property and its
-attributes (TYPE `:property').
+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
+list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for 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/fileio.c b/src/fileio.c
index 1e4ca82..6d0bafa 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2919,6 +2919,11 @@ DEFUN ("file-directory-p", Ffile_directory_p,
Sfile_directory_p, 1, 1, 0,
doc: /* Return t if FILENAME names an existing directory.
Return nil if FILENAME does not name a directory, or if there
was trouble determining whether FILENAME is a directory.
+
+As a special case, this function will also return t if FILENAME is the
+empty string (\"\"). This quirk is due to Emacs interpreting the
+empty string (in some cases) as the current directory.
+
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
diff --git a/src/w32term.c b/src/w32term.c
index 1766b32..2669f29 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -5478,15 +5478,15 @@ w32_read_socket (struct terminal *terminal,
/* Windows can send us a SIZE_MAXIMIZED message even
when fullscreen is fullboth. The following is a
simple hack to check that based on the fact that
- only a maximized fullscreen frame should have both
- top/left outside the screen. */
+ only a maximized fullscreen frame should have top
+ or left outside the screen. */
if (EQ (fullscreen, Qfullwidth) || EQ (fullscreen,
Qfullheight)
|| NILP (fullscreen))
{
int x, y;
w32_real_positions (f, &x, &y);
- if (x < 0 && y < 0)
+ if (x < 0 || y < 0)
store_frame_param (f, Qfullscreen, Qmaximized);
}
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 406b2d7..69e5a9e 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -19308,20 +19308,21 @@ try_window (Lisp_Object window, struct text_pos pos,
int flags)
if ((flags & TRY_WINDOW_CHECK_MARGINS)
&& !MINI_WINDOW_P (w))
{
- int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
+ int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
+ int bot_scroll_margin = top_scroll_margin;
if (window_wants_header_line (w))
- this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
+ top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
start_display (&it, w, pos);
if ((w->cursor.y >= 0 /* not vscrolled */
- && w->cursor.y < this_scroll_margin
+ && w->cursor.y < top_scroll_margin
&& CHARPOS (pos) > BEGV)
/* rms: considering make_cursor_line_fully_visible_p here
seems to give wrong results. We don't want to recenter
when the last line is partly visible, we want to allow
that case to be handled in the usual way. */
|| w->cursor.y > (it.last_visible_y - partial_line_height (&it)
- - this_scroll_margin - 1))
+ - bot_scroll_margin - 1))
{
w->cursor.vpos = -1;
clear_glyph_matrix (w->desired_matrix);
diff --git a/test/Makefile.in b/test/Makefile.in
index d1da02e..9974eb5 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -89,11 +89,6 @@ unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
## To run tests under a debugger, set this to eg: "gdb --args".
GDB =
-# The locale to run tests under. Tests should work if this is set to
-# any supported locale. Use the C locale by default, as it should be
-# supported everywhere.
-TEST_LOCALE = C
-
# Set this to 'yes' to run the tests in an interactive instance.
TEST_INTERACTIVE ?= no
@@ -128,7 +123,7 @@ endif
# The actual Emacs command run in the targets below.
# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \
+emacs = EMACSLOADPATH= \
EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
$(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index ec3e4bb..3243a80 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -156,6 +156,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for a file."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let ((tmpfile (make-temp-file "auto-revert-test"))
buf)
(unwind-protect
@@ -356,6 +357,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert tail mode."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let ((tmpfile (make-temp-file "auto-revert-test"))
buf)
(unwind-protect
@@ -394,6 +396,7 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for dired."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
+ :tags '(:expensive-test)
(let* ((tmpfile (make-temp-file "auto-revert-test"))
(name (file-name-nondirectory tmpfile))
buf)
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index c8cb97a..0909756 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -63,22 +63,16 @@ An existing calc stack is reused, otherwise a new one is
created."
(calc-top-n 1))
(calc-pop 0)))
-;; (ert-deftest test-math-bignum ()
-;; ;; bug#17556
-;; (let ((n (math-bignum most-negative-fixnum)))
-;; (should (math-negp n))
-;; (should (cl-notany #'cl-minusp (cdr n)))))
-
-(ert-deftest test-calc-remove-units ()
+(ert-deftest calc-remove-units ()
(should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m")
-1)))
-(ert-deftest test-calc-extract-units ()
+(ert-deftest calc-extract-units ()
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m")
'(var m var-m)))
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm")
'(* (float 1 -2) (^ (var m var-m) 2)))))
-(ert-deftest test-calc-convert-units ()
+(ert-deftest calc-convert-units ()
;; Used to ask for `(The expression is unitless when simplified) Old Units:
'.
(should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil
"cm")
'(* -100 (var cm var-cm))))
@@ -94,7 +88,7 @@ An existing calc stack is reused, otherwise a new one is
created."
(let ((var-i (calcFunc-sqrt -1)))
(should (math-imaginary-i))))
-(ert-deftest test-calc-23889 ()
+(ert-deftest calc-bug-23889 ()
"Test for https://debbugs.gnu.org/23889 and 25652."
(skip-unless t) ;; (>= math-bignum-digit-length 9))
(dolist (mode '(deg rad))
@@ -139,7 +133,7 @@ An existing calc stack is reused, otherwise a new one is
created."
(nth 1 (calcFunc-cos 1)))
0 4))))))
-(ert-deftest calc-test-trig ()
+(ert-deftest calc-trig ()
"Trigonometric simplification; bug#33052."
(let ((calc-angle-mode 'rad))
(let ((calc-symbolic-mode t))
@@ -169,7 +163,7 @@ An existing calc stack is reused, otherwise a new one is
created."
(should (equal (math-simplify '(calcFunc-cot (/ (var pi var-pi) 3)))
'(calcFunc-cot (/ (var pi var-pi) 3)))))))
-(ert-deftest calc-test-format-radix ()
+(ert-deftest calc-format-radix ()
"Test integer formatting (bug#36689)."
(let ((calc-group-digits nil))
(let ((calc-number-radix 10))
@@ -194,7 +188,7 @@ An existing calc stack is reused, otherwise a new one is
created."
(let ((calc-number-radix 36))
(should (equal (math-format-number 12345678901) "36#5,O6A,QT1")))))
-(ert-deftest calc-test-calendar ()
+(ert-deftest calc-calendar ()
"Test calendar conversions (bug#36822)."
(should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692))
(should (equal (math-parse-date "2019-07-27") '(date 737267)))
@@ -216,7 +210,7 @@ An existing calc stack is reused, otherwise a new one is
created."
(should (equal (math-absolute-from-julian-dt -101 3 1) -36832))
(should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425)))
-(ert-deftest calc-test-solve-linear-system ()
+(ert-deftest calc-solve-linear-system ()
"Test linear system solving (bug#35374)."
;; x + y = 3
;; 2x - 3y = -4
diff --git a/test/lisp/cedet/semantic-utest-c.el
b/test/lisp/cedet/semantic-utest-c.el
index bdd6c05..c776a0f 100644
--- a/test/lisp/cedet/semantic-utest-c.el
+++ b/test/lisp/cedet/semantic-utest-c.el
@@ -1,4 +1,4 @@
-;;; semantic-utest-c.el --- C based parsing tests.
+;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -40,11 +40,13 @@
(defvar semantic-utest-c-test-directory (expand-file-name "tests"
cedet-utest-directory)
"Location of test files.")
+(defvar semantic-lex-c-nested-namespace-ignore-second)
+
;;; Code:
;;;###autoload
(ert-deftest semantic-test-c-preprocessor-simulation ()
"Run parsing test for C from the test directory."
- (interactive)
+ :tags '(:expensive-test)
(semantic-mode 1)
(dolist (fp semantic-utest-c-comparisons)
(let* ((semantic-lex-c-nested-namespace-ignore-second nil)
@@ -146,33 +148,32 @@ gcc version 2.95.2 19991024 (release)"
(ert-deftest semantic-test-gcc-output-parser ()
"Test the output parser against some collected strings."
- (let ((fail nil))
- (dolist (S semantic-gcc-test-strings)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc 'target fields))
- (cdr (assoc '--target fields))
- (cdr (assoc '--host fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- ;; No longer test for prefixes.
- (when (not (and v h))
- (let ((strs (split-string S "\n")))
- (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)
- ))
- (should (and v h))
- ))
- (dolist (S semantic-gcc-test-strings-fail)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc '--host fields))
- (cdr (assoc 'target fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- ;; negative test
- (should-not (and v h p))
- ))
- ))
+ (dolist (S semantic-gcc-test-strings)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc 'target fields))
+ (cdr (assoc '--target fields))
+ (cdr (assoc '--host fields))))
+ (p (cdr (assoc '--prefix fields)))
+ )
+ ;; No longer test for prefixes.
+ (when (not (and v h))
+ (let ((strs (split-string S "\n")))
+ (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)
+ ))
+ (should (and v h))
+ ))
+ (dolist (S semantic-gcc-test-strings-fail)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc '--host fields))
+ (cdr (assoc 'target fields))))
+ (p (cdr (assoc '--prefix fields)))
+ )
+ ;; negative test
+ (should-not (and v h p))
+ ))
+ )
(provide 'semantic-utest-c)
diff --git a/test/lisp/cedet/srecode-utest-getset.el
b/test/lisp/cedet/srecode-utest-getset.el
index 3419b18..fc66ac4 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -55,6 +55,7 @@ private:
(defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler.
(ert-deftest srecode-utest-getset-output ()
"Test various template insertion options."
+ :tags '(:expensive-test)
(save-excursion
(let ((testbuff (find-file-noselect srecode-utest-getset-testfile))
(srecode-insert-getset-fully-automatic-flag t))
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 5c6649c..cec533d 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -24,11 +24,11 @@
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
(should
- (fboundp 'dired-jump))
+ (fboundp 'dired-do-relsymlink))
(should
(autoloadp
(symbol-function
- 'dired-jump))))
+ 'dired-do-relsymlink))))
(ert-deftest dired-test-bug22694 ()
"Test for https://debbugs.gnu.org/22694 ."
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el
b/test/lisp/emacs-lisp/cl-seq-tests.el
index cddefbb..7e0f538 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,6 +294,7 @@ Body are forms defining the test."
(ert-deftest cl-seq-test-bug24264 ()
"Test for https://debbugs.gnu.org/24264 ."
+ :tags '(:expensive-test)
(let ((list (append (make-list 8000005 1) '(8)))
(list2 (make-list 8000005 2)))
(should (cl-position 8 list))
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 10e3b53..29e4273 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -135,8 +135,9 @@
"--eval"
(prin1-to-string '(progn (setf (gv-test-foo gv-test-pair)
99)
(message "%d" (car
gv-test-pair)))))
- (should (equal (buffer-string)
- "Symbol's function definition is void: \\(setf\\
gv-test-foo\\)\n")))))
+ (should (string-match
+ "\\`Symbol.s function definition is void: \\\\(setf\\\\
gv-test-foo\\\\)\n\\'"
+ (buffer-string))))))
(ert-deftest gv-setter-edebug ()
"Check that a setter can be defined and edebugged together with
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index dd8ae39..cbb2410 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -492,6 +492,7 @@ Must called from within a `tar-mode' buffer."
(ert-deftest package-test-update-archives-async ()
"Test updating package archives asynchronously."
+ :tags '(:expensive-test)
(skip-unless (executable-find "python2"))
(let* ((package-menu-async t)
(default-directory package-test-data-dir)
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 42d86ee..47ed661 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -611,6 +611,7 @@ delivered."
(ert-deftest file-notify-test03-events ()
"Check file creation/change/removal notifications."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
@@ -888,6 +889,7 @@ delivered."
(ert-deftest file-notify-test04-autorevert ()
"Check autorevert via file notification."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
;; `auto-revert-buffers' runs every 5". And we must wait, until the
@@ -983,6 +985,7 @@ delivered."
(ert-deftest file-notify-test05-file-validity ()
"Check `file-notify-valid-p' for files."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
@@ -1235,6 +1238,7 @@ delivered."
(ert-deftest file-notify-test08-backup ()
"Check that backup keeps file notification."
+ :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 673fa69..ba0783b 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -1,5 +1,5 @@
-;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt.
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*-
lexical-binding:t -*-
+;; Copyright (C) 2015, 2020 Free Software Foundation, Inc.
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
@@ -51,6 +51,8 @@ Mostly, the empty passphrase is used. However, the keys for
'(sign-pgp sign-pgp-mime sign-smime)
'(sign-pgp sign-pgp-mime)))
+(defvar mml-smime-use)
+
(defun mml-secure-test-fixture (body &optional interactive)
"Setup GnuPG home containing test keys and prepare environment for BODY.
If optional INTERACTIVE is non-nil, allow questions to the user in case of
@@ -80,7 +82,9 @@ instead of gpg-agent."
;; not look in the proper places otherwise, see:
;; https://bugs.gnupg.org/gnupg/issue2126
(setenv "GNUPGHOME" epg-gpg-home-directory)
- (funcall body))
+ (unwind-protect
+ (funcall body)
+ (mml-sec-test--kill-gpg-agent)))
(error
(setenv "GPG_AGENT_INFO" agent-info)
(setenv "GNUPGHOME" gpghome)
@@ -120,9 +124,9 @@ Subject: Test
Pass optional INTERACTIVE to mml-secure-test-fixture."
(mml-secure-test-fixture
(lambda ()
- (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime))
- (epg-make-context 'CMS)
- (epg-make-context 'OpenPGP)))
+ (let ((_context (if (memq method '(enc-smime enc-sign-smime sign-smime))
+ (epg-make-context 'CMS)
+ (epg-make-context 'OpenPGP)))
;; Verify and decrypt by default.
(mm-verify-option 'known)
(mm-decrypt-option 'known)
@@ -546,6 +550,10 @@ Pass optional INTERACTIVE to mml-secure-test-mail-fixture."
))))))
interactive))
+(defvar mml-smime-cache-passphrase)
+(defvar mml2015-cache-passphrase)
+(defvar mml1991-cache-passphrase)
+
(defun mml-secure-test-en-decrypt-with-passphrase
(method to from checksig jl-passphrase do-cache
&optional enc-keys expectfail)
@@ -562,7 +570,7 @@ If optional EXPECTFAIL is non-nil, a decryption failure is
expected."
(mml-smime-cache-passphrase do-cache)
)
(cl-letf (((symbol-function 'read-passwd)
- (lambda (prompt &optional confirm default) jl-passphrase)))
+ (lambda (_prompt &optional _confirm _default) jl-passphrase)))
(mml-secure-test-en-decrypt method to from checksig t enc-keys
expectfail)
)))
@@ -897,4 +905,16 @@ So the second decryption fails."
(let ((with-smime nil))
(ert-run-tests-batch)))
-;;; gnustest-mml-sec.el ends here
+(defun mml-sec-test--kill-gpg-agent ()
+ (dolist (pid (list-system-processes))
+ (let ((atts (process-attributes pid)))
+ (when (and (equal (cdr (assq 'user atts)) (user-login-name))
+ (equal (cdr (assq 'comm atts)) "gpg-agent")
+ (string-match
+ (concat "homedir.*"
+ (regexp-quote (expand-file-name "test/data/mml-sec"
+ source-directory)))
+ (cdr (assq 'args atts))))
+ (call-process "kill" nil nil nil (format "%d" pid))))))
+
+;;; mml-sec-tests.el ends here
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 8b456c3..d470bca 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -25,6 +25,8 @@
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
+(setq dbus-show-dbus-errors nil)
+
(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
@@ -41,7 +43,7 @@
(defconst dbus--test-path "/org/gnu/Emacs/TestDBus"
"Test object path.")
-(defconst dbus--test-interface "org.gnu.Emacs.TestDBus"
+(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
"Test interface.")
(defun dbus--test-availability (bus)
@@ -109,8 +111,16 @@
(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))
- (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-register-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args)))
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-unregister-service bus dbus-service-dbus)))
+ `(dbus-error ,dbus-error-invalid-args))))
(ert-deftest dbus-test02-register-service-session ()
"Check service registration at `:session' bus."
@@ -204,28 +214,39 @@ This includes initialization and closing the bus."
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
(unwind-protect
- (let ((method "Method")
- (handler #'dbus--test-method-handler))
+ (let ((method1 "Method1")
+ (method2 "Method2")
+ (handler #'dbus--test-method-handler)
+ registered)
(should
(equal
+ (setq
+ registered
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 handler))
+ `((:method :session ,dbus--test-interface ,method1)
+ (,dbus--test-service ,dbus--test-path ,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-interface method2 handler)
+ `((:method :session ,dbus--test-interface ,method2)
(,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))
+ dbus--test-interface method1))
;; One argument, returns the argument.
(should
(string-equal
(dbus-call-method
:session dbus--test-service dbus--test-path
- dbus--test-interface method "foo")
+ dbus--test-interface method1 "foo")
"foo"))
;; Two arguments, D-Bus error activated as `(:error ...)' list.
(should
@@ -233,7 +254,7 @@ This includes initialization and closing the bus."
(should-error
(dbus-call-method
:session dbus--test-service dbus--test-path
- dbus--test-interface method "foo" "bar"))
+ dbus--test-interface method1 "foo" "bar"))
`(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)")))
;; Three arguments, D-Bus error activated by `dbus-error' signal.
(should
@@ -241,14 +262,28 @@ This includes initialization and closing the bus."
(should-error
(dbus-call-method
:session dbus--test-service dbus--test-path
- dbus--test-interface method "foo" "bar" "baz"))
+ dbus--test-interface method1 "foo" "bar" "baz"))
`(dbus-error
,dbus-error-failed
- "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\""))))
+ "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\"")))
+
+ ;; Unregister method.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 :timeout 10 "foo")))
+ `(dbus-error ,dbus-error-no-reply))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+;; TODO: Test emits-signal.
(ert-deftest dbus-test05-register-property ()
"Check property registration for an own service."
(skip-unless dbus--test-enabled-session-bus)
@@ -257,21 +292,19 @@ This includes initialization and closing the bus."
(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))
+ (property3 "Property3")
+ (property4 "Property4")
+ registered)
;; `: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)
+ (setq
+ registered
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :read "foo"))
+ `((:property :session ,dbus--test-interface ,property1)
(,dbus--test-service ,dbus--test-path))))
(should
(string-equal
@@ -279,10 +312,22 @@ This includes initialization and closing the bus."
:session dbus--test-service dbus--test-path
dbus--test-interface property1)
"foo"))
- (should-not ;; Due to `:read' access type.
+ ;; Due to `:read' access type, we don't get a proper reply
+ ;; from `dbus-set-property'.
+ (should-not
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 "foofoo"))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")))
+ `(dbus-error ,dbus-error-property-read-only))))
(should
(string-equal
(dbus-get-property
@@ -296,12 +341,24 @@ This includes initialization and closing the bus."
(dbus-register-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2 :write "bar")
- `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ `((:property :session ,dbus--test-interface ,property2)
(,dbus--test-service ,dbus--test-path))))
- (should-not ;; Due to `:write' access type.
+ ;; Due to `:write' access type, we don't get a proper reply
+ ;; from `dbus-get-property'.
+ (should-not
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)))
+ `(dbus-error ,dbus-error-access-denied))))
(should
(string-equal
(dbus-set-property
@@ -319,7 +376,7 @@ This includes initialization and closing the bus."
(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)
+ `((:property :session ,dbus--test-interface ,property3)
(,dbus--test-service ,dbus--test-path))))
(should
(string-equal
@@ -340,6 +397,36 @@ This includes initialization and closing the bus."
dbus--test-interface property3)
"/baz/baz"))
+ ;; Not registered property.
+ (should-not
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4)))
+ `(dbus-error ,dbus-error-unknown-property))))
+ (should-not
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz"))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property4 "foobarbaz")))
+ `(dbus-error ,dbus-error-unknown-property))))
+
;; `dbus-get-all-properties'. We cannot retrieve a value for
;; the property with `:write' access type.
(let ((result
@@ -359,7 +446,25 @@ This includes initialization and closing the bus."
(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))))
+ (should-not (assoc property2 result)))
+
+ ;; Unregister property.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered))
+ (should-not
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1))
+ (let ((dbus-show-dbus-errors t))
+ (should
+ (equal
+ ;; We don't care the error message text.
+ (butlast
+ (should-error
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)))
+ `(dbus-error ,dbus-error-unknown-property)))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
@@ -381,14 +486,14 @@ This includes initialization and closing the bus."
(dbus-register-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 :readwrite "foo")
- `((:property :session "org.gnu.Emacs.TestDBus" ,property1)
+ `((:property :session ,dbus--test-interface ,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)
+ `((:property :session ,dbus--test-interface ,property2)
(,dbus--test-service ,dbus--test-path))))
(should
(string-equal
@@ -434,14 +539,14 @@ This includes initialization and closing the bus."
(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)
+ `((:property :session ,dbus--test-interface ,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)
+ `((:property :session ,dbus--test-interface ,property3)
(,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
(should
(string-equal
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
index 07e30b6..5205f0b 100644
--- a/test/lisp/net/gnutls-tests.el
+++ b/test/lisp/net/gnutls-tests.el
@@ -241,6 +241,7 @@
(ert-deftest test-gnutls-005-aead-ciphers ()
"Test the GnuTLS AEAD ciphers"
+ :tags '(:expensive-test)
(skip-unless (memq 'AEAD-ciphers (gnutls-available-p)))
(setq gnutls-tests-message-prefix "AEAD verification: ")
(let ((keys '("mykey" "mykey2"))
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 8c75d91..9a23191 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -48,6 +48,12 @@
(expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory))
"The test file archive.")
+(defun tramp-archive-test-file-archive-hexlified ()
+ "Return hexlified `tramp-archive-test-file-archive'.
+Do not hexlify \"/\". This hexlified string is used in `file:///' URLs."
+ (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars)))
+ (url-hexify-string tramp-archive-test-file-archive)))
+
(defconst tramp-archive-test-archive
(file-name-as-directory tramp-archive-test-file-archive)
"The test archive.")
@@ -174,7 +180,8 @@ variables, so we check the Emacs version directly."
(should
(string-equal
host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (url-hexify-string
+ (concat "file://" (tramp-archive-test-file-archive-hexlified)))))
(should-not port)
(should (string-equal localname "/"))
(should (string-equal archive tramp-archive-test-file-archive)))
@@ -193,7 +200,8 @@ variables, so we check the Emacs version directly."
(should
(string-equal
host
- (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+ (url-hexify-string
+ (concat "file://" (tramp-archive-test-file-archive-hexlified)))))
(should-not port)
(should (string-equal localname "/foo"))
(should (string-equal archive tramp-archive-test-file-archive)))
@@ -237,7 +245,8 @@ variables, so we check the Emacs version directly."
;; archive boundaries. So we must cut the
;; trailing slash ourselves.
(substring
- (file-name-directory tramp-archive-test-file-archive)
+ (file-name-directory
+ (tramp-archive-test-file-archive-hexlified))
0 -1)))
nil "/"))
(file-name-nondirectory tramp-archive-test-file-archive)))))
diff --git a/test/lisp/org/org-tests.el b/test/lisp/org/org-tests.el
index 918d79b..6e91dd2 100644
--- a/test/lisp/org/org-tests.el
+++ b/test/lisp/org/org-tests.el
@@ -1,4 +1,4 @@
-;;; org-tests.el --- tests for org/org.el
+;;; org-tests.el --- tests for org/org.el -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 03c62de..f40f6a1 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -125,6 +125,7 @@
Per definition, all files are identical on the different hosts of
a cluster (or site). This is not tested here; it must be
guaranteed by the originator of a cluster definition."
+ :tags '(:expensive-test)
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
(skip-unless (file-remote-p shadow-test-remote-temporary-file-directory))
@@ -865,6 +866,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test09-shadow-copy-files ()
"Check that needed shadow files are copied."
+ :tags '(:expensive-test)
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
(skip-unless (file-remote-p shadow-test-remote-temporary-file-directory))
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index e2761a9..2df5537 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -172,27 +172,28 @@
(should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list
"OTP-18.1.5")))
- "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "")))
- "Invalid version syntax: `' (must start with a number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "1.0..7.5")))
- "Invalid version syntax: `1.0..7.5'"))
- (should (equal
- (error-message-string (should-error (version-to-list
"1.0prepre2")))
- "Invalid version syntax: `1.0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list
"beta22.8alpha3")))
- "Invalid version syntax: `beta22.8alpha3' (must start with a
number)"))
- (should (equal
- (error-message-string (should-error (version-to-list "honk")))
- "Invalid version syntax: `honk' (must start with a number)"))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"OTP-18.1.5")))
+ "Invalid version syntax: `OTP-18.1.5' (must start with a
number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "")))
+ "Invalid version syntax: `' (must start with a number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "1.0..7.5")))
+ "Invalid version syntax: `1.0..7.5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"1.0prepre2")))
+ "Invalid version syntax: `1.0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"beta22.8alpha3")))
+ "Invalid version syntax: `beta22.8alpha3' (must start with a
number)"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "honk")))
+ "Invalid version syntax: `honk' (must start with a number)")))
(should (equal
(error-message-string (should-error (version-to-list 9)))
"Version must be a string"))
@@ -231,18 +232,19 @@
(should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2)))
(should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2)))
- (should (equal
- (error-message-string (should-error (version-to-list
"1_0__7_5")))
- "Invalid version syntax: `1_0__7_5'"))
- (should (equal
- (error-message-string (should-error (version-to-list
"1_0prepre2")))
- "Invalid version syntax: `1_0prepre2'"))
- (should (equal
- (error-message-string (should-error (version-to-list "22.8X3")))
- "Invalid version syntax: `22.8X3'"))
- (should (equal
- (error-message-string (should-error (version-to-list
"beta22_8alpha3")))
- "Invalid version syntax: `beta22_8alpha3' (must start with a
number)"))))
+ (let ((text-quoting-style 'grave))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"1_0__7_5")))
+ "Invalid version syntax: `1_0__7_5'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"1_0prepre2")))
+ "Invalid version syntax: `1_0prepre2'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list "22.8X3")))
+ "Invalid version syntax: `22.8X3'"))
+ (should (equal
+ (error-message-string (should-error (version-to-list
"beta22_8alpha3")))
+ "Invalid version syntax: `beta22_8alpha3' (must start with a
number)")))))
(ert-deftest subr-test-version-list-< ()
(should (version-list-< '(0) '(1)))
diff --git a/test/manual/indent/css-mode.css
b/test/lisp/textmodes/css-mode-resources/test-indent.css
similarity index 100%
rename from test/manual/indent/css-mode.css
rename to test/lisp/textmodes/css-mode-resources/test-indent.css
diff --git a/test/lisp/textmodes/css-mode-tests.el
b/test/lisp/textmodes/css-mode-tests.el
index 38cb73b..f627d1c 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -30,6 +30,12 @@
(require 'ert)
(require 'seq)
+(defvar css-mode-tests-data-dir
+ (file-truename
+ (expand-file-name "css-mode-resources/"
+ (file-name-directory (or load-file-name
+ buffer-file-name)))))
+
(ert-deftest css-test-property-values ()
;; The `float' property has a flat value list.
(should
@@ -411,5 +417,13 @@
(point))
"black")))))
+(ert-deftest css-mode-test-indent ()
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "test-indent.css"
+ css-mode-tests-data-dir))
+ (let ((orig (buffer-string)))
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig)))))
+
(provide 'css-mode-tests)
;;; css-mode-tests.el ends here
diff --git a/test/lisp/url/url-future-tests.el
b/test/lisp/url/url-future-tests.el
index 2c5d45d..a07730a 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -1,4 +1,4 @@
-;;; url-future-tests.el --- Test suite for url-future.
+;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t
-*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
@@ -25,31 +25,33 @@
(require 'ert)
(require 'url-future)
+(defvar url-future-tests--saver)
+
(ert-deftest url-future-tests ()
- (let* (saver
+ (let* (url-future-tests--saver
(text "running future")
(good (make-url-future :value (lambda () (format text))
- :callback (lambda (f) (set 'saver f))))
+ :callback (lambda (f) (set
'url-future-tests--saver f))))
(bad (make-url-future :value (lambda () (/ 1 0))
- :errorback (lambda (&rest d) (set 'saver d))))
+ :errorback (lambda (&rest d) (set
'url-future-tests--saver d))))
(tocancel (make-url-future :value (lambda () (/ 1 0))
- :callback (lambda (f) (set 'saver f))
+ :callback (lambda (f) (set
'url-future-tests--saver f))
:errorback (lambda (&rest d)
- (set 'saver d)))))
+ (set 'url-future-tests--saver
d)))))
(should (equal good (url-future-call good)))
- (should (equal good saver))
+ (should (equal good url-future-tests--saver))
(should (equal text (url-future-value good)))
(should (url-future-completed-p good))
(should-error (url-future-call good))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal bad (url-future-call bad)))
(should-error (url-future-call bad))
- (should (equal saver (list bad '(arith-error))))
+ (should (equal url-future-tests--saver (list bad '(arith-error))))
(should (url-future-errored-p bad))
- (setq saver nil)
+ (setq url-future-tests--saver nil)
(should (equal (url-future-cancel tocancel) tocancel))
(should-error (url-future-call tocancel))
- (should (null saver))
+ (should (null url-future-tests--saver))
(should (url-future-cancelled-p tocancel))))
(provide 'url-future-tests)
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index e497ed2..f17ec36 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -206,6 +206,11 @@ youthfulness
(ert-deftest diff-mode-test-font-lock ()
"Check font-locking of diff hunks."
+ ;; See comments in diff-hunk-file-names about nonascii.
+ ;; In such cases, the diff-font-lock-syntax portion of this fails.
+ :expected-result (if (string-match-p "[[:nonascii:]]"
+ diff-mode-tests--datadir)
+ :failed :passed)
(skip-unless (executable-find shell-file-name))
(skip-unless (executable-find diff-command))
(let ((default-directory diff-mode-tests--datadir)
@@ -244,6 +249,7 @@ youthfulness
111 124 (face diff-context)
124 127 (face diff-context))))
+ ;; Test diff-font-lock-syntax.
(should (equal (mapcar (lambda (o)
(list (- (overlay-start o) diff-beg)
(- (overlay-end o) diff-beg)
@@ -267,6 +273,9 @@ youthfulness
(ert-deftest diff-mode-test-font-lock-syntax-one-line ()
"Check diff syntax highlighting for one line with no newline at end."
+ :expected-result (if (string-match-p "[[:nonascii:]]"
+ diff-mode-tests--datadir)
+ :failed :passed)
(skip-unless (executable-find shell-file-name))
(skip-unless (executable-find diff-command))
(let ((default-directory diff-mode-tests--datadir)
diff --git a/test/manual/indent/elisp.el b/test/manual/indent/elisp.el
index f3874b5..7d634ae 100644
--- a/test/manual/indent/elisp.el
+++ b/test/manual/indent/elisp.el
@@ -1,3 +1,4 @@
+;; -*- lexical-binding:t -*-
(defun x ()
(print (quote ( thingy great
stuff)))
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index c2010ae..42dae42 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -29,7 +29,8 @@
(ert-deftest call-interactively/incomplete-multibyte-sequence ()
"Check that Bug#30004 is fixed."
- (let ((data (should-error (call-interactively (lambda () (interactive
"\xFF"))))))
+ (let* ((text-quoting-style 'grave)
+ (data (should-error (call-interactively (lambda () (interactive
"\xFF"))))))
(should
(equal
(cdr data)
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 0fd8e1d..096c6b3 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -309,7 +309,8 @@ local reference."
(ert-deftest module/describe-function-1 ()
"Check that Bug#30163 is fixed."
(with-temp-buffer
- (let ((standard-output (current-buffer)))
+ (let ((standard-output (current-buffer))
+ (text-quoting-style 'grave))
(describe-function-1 #'mod-test-sum)
(goto-char (point-min))
(while (re-search-forward "`[^']*/data/emacs-module/" nil t)