[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e763c89 2/4: Merge branch 'master' of git.sv.gnu.org:/srv/git/ema
From: |
Michael Albinus |
Subject: |
master e763c89 2/4: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs |
Date: |
Sun, 8 Aug 2021 10:19:09 -0400 (EDT) |
branch: master
commit e763c8947a55bfff703427b9bb0524638e5d7eae
Merge: 80cccd7 adab672
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
Makefile.in | 1 +
configure.ac | 33 +++++++-
doc/lispref/minibuf.texi | 12 +++
doc/lispref/package.texi | 9 ++-
doc/lispref/text.texi | 9 ++-
doc/misc/gnus.texi | 10 ++-
doc/misc/smtpmail.texi | 12 +--
etc/NEWS | 34 ++++++++
etc/refcards/pl-refcard.tex | 2 +-
etc/refcards/refcard.tex | 2 +-
lisp/cus-start.el | 1 +
lisp/delsel.el | 2 +-
lisp/emacs-lisp/bindat.el | 24 +++---
lisp/emacs-lisp/byte-opt.el | 12 +--
lisp/emacs-lisp/cl-generic.el | 12 ++-
lisp/emacs-lisp/comp.el | 4 +-
lisp/emacs-lisp/easy-mmode.el | 5 +-
lisp/emacs-lisp/edebug.el | 18 ++---
lisp/emacs-lisp/map.el | 8 +-
lisp/emacs-lisp/package.el | 12 +--
lisp/emacs-lisp/radix-tree.el | 2 +-
lisp/erc/erc-stamp.el | 51 +++++++-----
lisp/ffap.el | 6 +-
lisp/files.el | 8 +-
lisp/frame.el | 2 +-
lisp/gnus/gnus-search.el | 14 ++--
lisp/gnus/nnimap.el | 7 ++
lisp/image/image-converter.el | 12 +--
lisp/mail/smtpmail.el | 14 +++-
lisp/minibuffer.el | 10 +++
lisp/org/org-agenda.el | 2 +-
lisp/progmodes/elisp-mode.el | 7 +-
lisp/progmodes/etags.el | 35 +++++++--
lisp/progmodes/perl-mode.el | 17 ++--
lisp/progmodes/project.el | 27 +++----
lisp/progmodes/xref.el | 6 +-
lisp/replace.el | 1 +
lisp/simple.el | 10 ++-
lisp/so-long.el | 3 +-
lisp/thingatpt.el | 19 ++++-
lisp/url/url.el | 128 ++++++++++++-------------------
lisp/vc/smerge-mode.el | 3 +
src/Makefile.in | 7 +-
src/minibuf.c | 22 +++++-
src/xdisp.c | 9 ++-
test/lisp/emacs-lisp/bytecomp-tests.el | 9 +++
test/lisp/emacs-lisp/checkdoc-tests.el | 8 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 6 +-
test/lisp/ffap-tests.el | 19 +++++
test/lisp/files-tests.el | 50 ++++++++----
test/lisp/progmodes/perl-mode-tests.el | 7 ++
51 files changed, 480 insertions(+), 263 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 97d954b..235b707 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -789,6 +789,7 @@ install-etc:
### Install native compiled Lisp files.
install-eln: lisp
ifeq ($(HAVE_NATIVE_COMP),yes)
+ umask 022 ; \
find native-lisp -type d -exec $(MKDIR_P) "$(ELN_DESTDIR){}" \; ; \
find native-lisp -type f -exec ${INSTALL_DATA} "{}" "$(ELN_DESTDIR){}"
\;
endif
diff --git a/configure.ac b/configure.ac
index 79cc56f..be97d9c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1334,6 +1334,9 @@ if test -n "$BREW"; then
[`$BREW --prefix texinfo 2>/dev/null`/bin$PATH_SEPARATOR$PATH])
fi
+# Check MacPorts on macOS.
+AC_PATH_PROG(HAVE_MACPORTS, port)
+
## Require makeinfo >= 4.13 (last of the 4.x series) to build the manuals.
: ${MAKEINFO:=makeinfo}
case `($MAKEINFO --version) 2>/dev/null` in
@@ -3807,7 +3810,8 @@ source on this site:
<https://gcc.gnu.org/wiki/JIT>.])])
HAVE_NATIVE_COMP=no
-LIBGCCJIT_LIB=
+LIBGCCJIT_LIBS=
+LIBGCCJIT_CFLAGS=
if test "${with_native_compilation}" != "no"; then
if test "${HAVE_PDUMPER}" = no; then
AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper'])
@@ -3827,6 +3831,20 @@ if test "${with_native_compilation}" != "no"; then
fi
fi
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ # Determine which gcc version has been installed (gcc11, for
+ # instance).
+ PORT_PACKAGE=$(port installed active | grep '^ *gcc@<:@0-9@:>@* ' | \
+ awk '{ print $1; }')
+ MACPORTS_LIBGCCJIT_INCLUDE=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.h))
+ MACPORTS_LIBGCCJIT_LIB=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.dylib))
+ CFLAGS="$CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LDFLAGS="$LDFLAGS -L${MACPORTS_LIBGCCJIT_LIB}"
+ fi
+
# Check if libgccjit is available.
AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, [], [libgccjit_not_found])
AC_CHECK_HEADERS(libgccjit.h, [], [libgccjit_dev_not_found])
@@ -3841,17 +3859,24 @@ if test "${with_native_compilation}" != "no"; then
mingw32) ;;
# OpenBSD doesn't have libdl, all the functions are in libc
netbsd|openbsd)
- LIBGCCJIT_LIB="-lgccjit" ;;
+ LIBGCCJIT_LIBS="-lgccjit" ;;
*)
- LIBGCCJIT_LIB="-lgccjit -ldl" ;;
+ LIBGCCJIT_LIBS="-lgccjit -ldl" ;;
esac
NEED_DYNLIB=yes
AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if native compiler is
available.])
+
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ LIBGCCJIT_CFLAGS="$LIBGCCJIT_CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LIBGCCJIT_LIBS="-L${MACPORTS_LIBGCCJIT_LIB} $LIBGCCJIT_LIBS"
+ fi
fi
AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln",
[System extension for native compiled elisp])
AC_SUBST(HAVE_NATIVE_COMP)
-AC_SUBST(LIBGCCJIT_LIB)
+AC_SUBST(LIBGCCJIT_CFLAGS)
+AC_SUBST(LIBGCCJIT_LIBS)
DYNLIB_OBJ=
if test "${NEED_DYNLIB}" = yes; then
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd99..d54c654 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -469,6 +469,18 @@ If @var{default} is a non-@code{nil} list, the first
element of the
list is used in the prompt.
@end defun
+@defvar read-minibuffer-restore-windows
+If this option is non-@code{nil} (the default), getting input from the
+minibuffer will restore, on exit, the window configurations of the frame
+where the minibuffer was entered from and, if it is different, the frame
+that owns the minibuffer window. This means that if, for example, a
+user splits a window while getting input from the minibuffer on the same
+frame, that split will be undone when exiting the minibuffer.
+
+If this option is @code{nil}, no such restorations are done. Hence, the
+window split mentioned above will persist after exiting the minibuffer.
+@end defvar
+
@node Object from Minibuffer
@section Reading Lisp Objects with the Minibuffer
@cindex minibuffer input, reading lisp objects
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index e8aaa3a..9c033fe 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -283,11 +283,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here
is an example:
@section Creating and Maintaining Package Archives
@cindex package archive
+@cindex GNU ELPA
+@cindex non-GNU ELPA
Via the Package Menu, users may download packages from @dfn{package
archives}. Such archives are specified by the variable
-@code{package-archives}, whose default value contains a single entry:
-the archive hosted by the GNU project at @url{https://elpa.gnu.org}. This
-section describes how to set up and maintain a package archive.
+@code{package-archives}, whose default value lists the archives
+hosted on @url{https://elpa.gnu.org, GNU ELPA} and
+@url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes
+how to set up and maintain a package archive.
@cindex base location, package archive
@defopt package-archives
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e18ba47..9e0401f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -315,10 +315,11 @@ word on the same line is acceptable.
@defun thing-at-point thing &optional no-properties
Return the @var{thing} around or next to point, as a string.
-The argument @var{thing} is a symbol which specifies a kind of syntactic
-entity. Possibilities include @code{symbol}, @code{list}, @code{sexp},
-@code{defun}, @code{filename}, @code{url}, @code{word}, @code{sentence},
-@code{whitespace}, @code{line}, @code{page}, and others.
+The argument @var{thing} is a symbol which specifies a kind of
+syntactic entity. Possibilities include @code{symbol}, @code{list},
+@code{sexp}, @code{defun}, @code{filename}, @code{existing-filename},
+@code{url}, @code{word}, @code{sentence}, @code{whitespace},
+@code{line}, @code{page}, and others.
When the optional argument @var{no-properties} is non-@code{nil}, this
function strips text properties from the return value.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index c46047f..17da507 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -14516,7 +14516,8 @@ this should be set to @code{anonymous}. If this
variable isn't set,
the normal login methods will be used. If you wish to specify a
specific login method to be used, you can set this variable to either
@code{login} (the traditional @acronym{IMAP} login method),
-@code{plain} or @code{cram-md5}.
+@code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method
+requires using the @file{oauth2.el} library.)
@item nnimap-expunge
When to expunge deleted messages. If @code{never}, deleted articles
@@ -26860,9 +26861,10 @@ but at the common table.@*
If you want to investigate the person responsible for this outrage,
you can point your (feh!) web browser to
-@uref{https://quimby.gnus.org/}. This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is
-known as The Site That Destroys Newsrcs And Drives People Mad.
+@uref{https://quimby.gnus.org/}. This used to be the primary
+distribution point for the new and spiffy versions of Gnus, and was
+known as The Site That Destroys Newsrcs And Drives People Mad, but
+these days Gnus is developed in the Emacs repository.
During the first extended alpha period of development, the new Gnus was
called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index ca7dabe..f5d5675 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -264,12 +264,14 @@ file, @pxref{Top,,auth-source, auth, Emacs auth-source
Library}.
@cindex CRAM-MD5
@cindex PLAIN
@cindex LOGIN
-The process by which the SMTP library authenticates you to the server
-is known as ``Simple Authentication and Security Layer'' (SASL).
-There are various SASL mechanisms, and this library supports three of
-them: CRAM-MD5, PLAIN, and LOGIN, where the first uses a form of
+The process by which the @acronym{SMTP} library authenticates you to
+the server is known as ``Simple Authentication and Security Layer''
+(@acronym{SASL}). There are various @acronym{SASL} mechanisms, and
+this library supports three of them: @code{cram-md5}, @code{plain},
+@code{login} and @code{xoauth2}, where the first uses a form of
encryption to obscure your password, while the other two do not. It
-tries each of them, in that order, until one succeeds. You can
+tries each of them, in that order, until one succeeds.
+(@code{xoauth2} requires using the @file{oauth2.el} library. You can
override this by assigning a specific authentication mechanism to a
server by including a key @code{smtp-auth} with the value of your
preferred mechanism in the appropriate @file{~/.authinfo} entry.
diff --git a/etc/NEWS b/etc/NEWS
index 48dec0a..674152c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -179,6 +179,12 @@ behavior, which mixed these two, can be approximated by
customizing
nor t.
+++
+** New user option 'read-minibuffer-restore-windows'.
+When customized to nil, it uses 'minibuffer-restore-windows' in
+'minibuffer-exit-hook' to remove only the window showing the
+"*Completions*" buffer.
+
++++
** New system for displaying documentation for groups of functions.
This can either be used by saying 'M-x shortdoc-display-group' and
choosing a group, or clicking a button in the "*Help*" buffers when
@@ -810,6 +816,11 @@ work as before.
It is now defined as a generalized variable that can be used with
'setf' to modify the value stored in a given class slot.
+---
+*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
+This corresponds to the behaviour of defmethod in Common Lisp Object System.
+For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now.
+
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
@@ -992,6 +1003,9 @@ String or list of strings specifying switches for Git log
under VC.
** Gnus
+++
+*** nnimap now supports the oauth2.el library.
+
++++
*** New Summary buffer sort options for extra headers.
The extra header sort option ('C-c C-s C-x') prompts for a header
and fails if no sort function has been defined. Sorting by
@@ -1180,6 +1194,9 @@ take the actual screenshot, and defaults to "ImageMagick
import".
** Smtpmail
+++
+*** smtpmail now supports using the oauth2.el library.
+
++++
*** New user option 'smtpmail-store-queue-variables'.
If non-nil, SMTP variables will be stored together with the queued
messages, and will then be used when sending with
@@ -2058,6 +2075,13 @@ project's root directory, respectively.
This command lets you interactively remove an entry from the list of projects
in 'project-list-file'.
+*** 'project-find-file' now accepts non-existent file names.
+This is to allow easy creation of files inside some nested
+sub-directory.
+
+*** 'project-find-file' doesn't use the string at point as default input.
+Now it's only suggested as part of the "future history".
+
** xref
---
@@ -2631,6 +2655,11 @@ The semantics are as with 'walk-windows'.
If non-nil, 'find-file-at-point' and friends will try to guess more
expansively to identify a file name with spaces.
++++
+*** New 'thing-at-point' target: 'existing-filename'.
+This is like 'filename', but is a full path, and is nil if the file
+doesn't exist.
+
---
*** Two new commands for centering in 'doc-view-mode'.
The new commands 'doc-view-center-page-horizontally' (bound to 'c h')
@@ -3668,6 +3697,11 @@ Emacs constructs the nondirectory part of the auto-save
file name by
applying that 'secure-hash' to the buffer file name. This avoids any
risk of excessively long file names.
+---
+** New user option 'etags-xref-prefer-current-file'.
+When non-nil, matches for identifiers in the file visited by the
+current buffer will be shown first in the "*xref*" buffer.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index b31b427..c9d9678 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -394,7 +394,7 @@ po polsku.
\key{szukaj wstecz tekstu zgodnego z~wpisywanym wyra/zeniem regularnym}{C-M-r}
%\key{select previous search string}{M-p}
-%\key{select next later search string}{M-n}
+%\key{select next search string}{M-n}
%\key{exit incremental search}{RET}
%\key{undo effect of last character}{DEL}
%\key{abort current search}{C-g}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index f7b5da4..4cb8f9d 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -322,7 +322,7 @@ the directions. If you are a first-time user, type
\kbd{C-h t} for a
\key{reverse regular expression search}{C-M-r}
\key{select previous search string}{M-p}
-\key{select next later search string}{M-n}
+\key{select next search string}{M-n}
\key{exit incremental search}{RET}
\key{undo effect of last character}{DEL}
\key{abort current search}{C-g}
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 7df70d7..1997530 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -431,6 +431,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
"21.1"
:set minibuffer-prompt-properties--setter)
(minibuffer-auto-raise minibuffer boolean)
+ (read-minibuffer-restore-windows minibuffer boolean "28.1")
;; options property set at end
(read-buffer-function minibuffer
(choice (const nil)
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 3c99dd2..93fdc6a 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -300,7 +300,7 @@ then it takes a second \\[keyboard-quit] to abort the
minibuffer."
(interactive)
(if (and delete-selection-mode (region-active-p))
(setq deactivate-mark t)
- (abort-recursive-edit)))
+ (abort-minibuffers)))
(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91..76c2e80 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ The port (if any) is omitted. IP can be a string, as
well."
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
is the name of a variable that will hold the value we need to pack.")
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
(bindat--pcase op
('unpack `(bindat--unpack-u8))
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uint ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uintr ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql str)) len)
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
('unpack `(bindat--unpack-str ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
@@ -701,25 +701,25 @@ is the name of a variable that will hold the value we
need to pack.")
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
-(cl-defmethod bindat--type (op (_ (eql bits)) len)
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
('unpack `(bindat--unpack-bits ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
-(cl-defmethod bindat--type (_op (_ (eql fill)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
`(progn (cl-incf bindat-idx ,len) nil))
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
(bindat--pcase op
('unpack `(funcall (bindat--type-ue ,exp)))
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
(unless type (setq type '(byte)))
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
(bindat--pcase op
@@ -743,10 +743,10 @@ is the name of a variable that will hold the value we
need to pack.")
`(dotimes (bindat--i ,count)
(funcall ,fun (elt ,val bindat--i)))))))
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
(pcase op ('unpack val) (_ nil)))
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
(apply #'bindat--type op args))
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 96072ea..6475f69 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -601,15 +601,9 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
- ;; Set a new value or inhibit further substitution.
- (setcdr (cdr lexvar)
- (and
- ;; Inhibit if bound outside conditional code.
- (not (assq var byte-optimize--vars-outside-condition))
- ;; The new value must be substitutable.
- (byte-optimize--substitutable-p value)
- (list value)))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil)) ; Inhibit further substitution.
+
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704b..db5a5a0 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1158,7 +1158,17 @@ These match if the argument is a cons cell whose car is
`eql' to VAL."
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
"Support for (eql VAL) specializers.
These match if the argument is `eql' to VAL."
- (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (let ((form (cadr specializer)))
+ (puthash (if (or (not (symbolp form)) (macroexp-const-p form))
+ (eval form t)
+ ;; FIXME: Compatibility with Emacs<28. For now emitting
+ ;; a warning would be annoying for third party packages
+ ;; which can't use the new form without breaking compatibility
+ ;; with older Emacsen, but in the future we should emit
+ ;; a warning.
+ ;; (message "Quoting obsolete `eql' form: %S" specializer)
+ form)
+ specializer cl--generic-eql-used))
(list cl--generic-eql-generalizer))
(cl--generic-prefill-dispatchers 0 (eql nil))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 638d4b2..a04413b 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3936,7 +3936,9 @@ display a message."
(concat "emacs-async-comp-"
(file-name-base source-file) "-")
nil ".el"))
- (expr-strings (mapcar #'prin1-to-string expr))
+ (expr-strings (let ((print-length nil)
+ (print-level nil))
+ (mapcar #'prin1-to-string expr)))
(_ (progn
(with-temp-file temp-file
(mapc #'insert expr-strings))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 3a00fdb..8a2b3b4 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -497,8 +497,11 @@ on if the hook has explicitly disabled it.
,(concat (format "Toggle %s in all buffers.\n" pretty-name)
(internal--format-docstring-line
"With prefix ARG, enable %s if ARG is positive; otherwise, \
-disable it. If called from Lisp, enable the mode if ARG is omitted or
nil.\n\n"
+disable it.\n\n"
pretty-global-name)
+ "If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.\n\n"
(internal--format-docstring-line
"%s is enabled in all buffers where `%s' would do it.\n\n"
pretty-name turn-on)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec819..7def9ff 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
@@ -1755,7 +1755,7 @@ contains a circular object."
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
(let (edebug-best-error
edebug-error-point)
@@ -1768,7 +1768,7 @@ contains a circular object."
(edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
"Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ a sequence of elements."
(append instrumented-head (edebug-match cursor newspecs)))
,@args))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ a sequence of elements."
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ a sequence of elements."
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ a sequence of elements."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ a sequence of elements."
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9..c593428 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -407,15 +407,15 @@ See `map-into' for all supported values of TYPE."
"Convert MAP into a map of TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
"Convert MAP into a plist."
(let (plist)
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +510,7 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
"Convert MAP into a hash-table with keys compared with `equal'."
(map--into-hash map (list :size (map-length map) :test #'equal)))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index f1daa8d..dfd2148 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1366,11 +1366,9 @@ errors signaled by ERROR-FORM or by BODY).
(kill-buffer buffer)
(goto-char (point-min))))))
(package--unless-error body
- (let ((url (expand-file-name file url)))
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name"
- url))
- (insert-file-contents-literally url)))))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name" url))
+ (insert-file-contents-literally (expand-file-name file url)))))
(define-error 'bad-signature "Failed to verify signature")
@@ -4171,7 +4169,9 @@ activations need to be changed, such as when
`package-load-list' is modified."
;; Prefer uncompiled files (and don't accept .so files).
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
- (pfile (prin1-to-string file)))
+ (pfile (let ((print-length nil)
+ (print-level nil))
+ (prin1-to-string file))))
(insert "(let ((load-true-file-name " pfile ")\
(load-file-name " pfile "))\n")
(insert-file-contents file)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb65975..a529ed0 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ PREFIX is only used internally."
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 31de9e8..dde2556 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -181,6 +181,11 @@ or `erc-send-modify-hook'."
(list (lambda (_window _before dir)
(erc-echo-timestamp dir ct))))))))
+(defvar-local erc-timestamp-last-window-width nil
+ "Stores the width of the last window that showed the current
+buffer. This is used by `erc-insert-timestamp-right' when the
+current buffer is not shown in any window.")
+
(defvar-local erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
@@ -250,27 +255,32 @@ property to get to the POSth column."
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
-STRING is the timestamp to insert. The function is a possible value
-for `erc-insert-timestamp-function'.
-
-If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
-printed. If this variable is non-nil, a timestamp is only printed if
-it is different from the last.
-
-If `erc-timestamp-right-column' is set, its value will be used as the
-column at which the timestamp is to be printed. If it is nil, and
-`erc-fill-mode' is active, then the timestamp will be printed just
-before `erc-fill-column'. Otherwise, if the current buffer is
-shown in a window, that window's width is used. If the buffer is
-not shown, and `fill-column' is set, then the timestamp will be
-printed just `fill-column'. As a last resort, the timestamp will
-be printed just before the window-width."
+STRING is the timestamp to insert. This function is a possible
+value for `erc-insert-timestamp-function'.
+
+If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is
+always printed. If this variable is non-nil, a timestamp is only
+printed if it is different from the last.
+
+If `erc-timestamp-right-column' is set, its value will be used as
+the column at which the timestamp is to be printed. If it is
+nil, and `erc-fill-mode' is active, then the timestamp will be
+printed just before `erc-fill-column'. Otherwise, if the current
+buffer is shown in a window, that window's width is used as the
+right boundary. In case multiple windows show the buffer, the
+width of the most recently selected one is used. If the buffer
+is not shown, the timestamp will be printed just before the
+window width of the last window that showed it. If the buffer
+was never shown, and `fill-column' is set, it will be printed
+just before `fill-column'. As a last resort, timestamp will be
+printed just after each line's text (no alignment)."
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
- (forward-char -1);; before the last newline
+ (forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
((and (boundp 'erc-fill-mode)
@@ -278,10 +288,15 @@ be printed just before the window-width."
(boundp 'erc-fill-column)
erc-fill-column)
(1+ (- erc-fill-column str-width)))
+ ((setq window (get-buffer-window nil t))
+ (setq erc-timestamp-last-window-width
+ (window-width window))
+ (- erc-timestamp-last-window-width str-width))
+ (erc-timestamp-last-window-width
+ (- erc-timestamp-last-window-width str-width))
(fill-column
(1+ (- fill-column str-width)))
- (t
- (- (window-width) str-width 1))))
+ (t (current-column))))
(from (point))
(col (current-column)))
;; The following is a kludge used to calculate whether to move
diff --git a/lisp/ffap.el b/lisp/ffap.el
index b398d1c..9be9c29 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1670,9 +1670,9 @@ See also the variables `ffap-dired-wildcards',
`ffap-newfile-prompt',
((or (not ffap-newfile-prompt)
(file-exists-p filename)
(y-or-n-p "File does not exist, create buffer? "))
- (funcall ffap-file-finder
- ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
- (expand-file-name filename)))
+ (find-file
+ ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
+ (expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-missing (list "Opening file buffer"
"No such file or directory"
diff --git a/lisp/files.el b/lisp/files.el
index 2b13d04..b58f90d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -782,7 +782,10 @@ nil (meaning `default-directory') as the associated list
element."
(let ((spath (substitute-env-vars search-path)))
(mapcar (lambda (f)
(if (equal "" f) nil
- (let ((dir (expand-file-name (file-name-as-directory f))))
+ (let ((dir (file-name-as-directory f)))
+ (when (file-name-absolute-p dir)
+ ;; Expand "~".
+ (setq dir (expand-file-name dir)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
@@ -6533,7 +6536,8 @@ see `replace-buffer-contents'."
;; See comments in revert-buffer-with-fine-grain for an explanation.
(defun revert-buffer-with-fine-grain-success-p ()
success))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime))))
(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
"Revert buffer preserving markers, overlays, etc.
diff --git a/lisp/frame.el b/lisp/frame.el
index 9b3d120..146fe27 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,7 @@ as its argument.")
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 39bde83..8182630 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -980,7 +980,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
@@ -1358,6 +1358,7 @@ Returns a list of [group article score] vectors."
server query &optional groups)
(let ((prefix (or (slot-value engine 'remove-prefix)
""))
+ (groups (mapcar #'gnus-group-short-name groups))
artlist article group)
(goto-char (point-min))
;; Prep prefix, we want to at least be removing the root
@@ -1384,7 +1385,6 @@ Returns a list of [group article score] vectors."
nil t)
nil t)
nil t))
- (setq group (gnus-group-full-name group server))
(setq article (file-name-nondirectory f-name)
article
;; TODO: Provide a cleaner way of producing final
@@ -1404,10 +1404,12 @@ Returns a list of [group article score] vectors."
(setq artlist (gnus-search-grep-search engine artlist grep-reg)))
;; Munge into the list of vectors expected by nnselect.
(mapcar (pcase-lambda (`(,_ ,article ,group ,score))
- (vector group article
- (if (numberp score)
- score
- (string-to-number score))))
+ (vector
+ (gnus-group-full-name group server)
+ article
+ (if (numberp score)
+ score
+ (string-to-number score))))
artlist)))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3e2a202..3cf6545 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -599,6 +599,13 @@ during splitting, which may be slow."
(eq nnimap-authenticator 'anonymous)
(eq nnimap-authenticator 'login)))
(nnimap-command "LOGIN %S %S" user password))
+ ((and (nnimap-capability "AUTH=XOAUTH2")
+ (eq nnimap-authenticator 'xoauth2))
+ (nnimap-command "AUTHENTICATE XOAUTH2 %s"
+ (base64-encode-string
+ (format "user=%s\001auth=Bearer %s\001\001"
+ (nnimap-quote-specials user)
+ (nnimap-quote-specials password)))))
((and (nnimap-capability "AUTH=CRAM-MD5")
(or (null nnimap-authenticator)
(eq nnimap-authenticator 'cram-md5)))
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f7..97bf1ac 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -133,7 +133,7 @@ data is returned as a string."
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ Only suffixes that map to `image-mode' are returned."
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ Only suffixes that map to `image-mode' are returned."
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 133a2e1..8e3927c 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -596,7 +596,7 @@ USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -618,13 +618,13 @@ USER and PASSWORD should be non-nil."
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
@@ -636,6 +636,14 @@ USER and PASSWORD should be non-nil."
(base64-encode-string (concat "\0" user "\0" password) t))
235))
+(cl-defmethod smtpmail-try-auth-method
+ (process (_mech (eql xoauth2)) user password)
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH XOAUTH2 "
+ (base64-encode-string
+ (concat "user=" user "\1auth=Bearer " password "\1\1") t))))
+
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 3751ba8..2c6340e 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2328,6 +2328,16 @@ variables.")
(setq deactivate-mark nil)
(throw 'exit nil))
+(defun minibuffer-restore-windows ()
+ "Restore some windows on exit from minibuffer.
+When `read-minibuffer-restore-windows' is nil, then this function
+added to `minibuffer-exit-hook' will remove at least the window
+that displays the \"*Completions*\" buffer."
+ (unless read-minibuffer-restore-windows
+ (minibuffer-hide-completions)))
+
+(add-hook 'minibuffer-exit-hook 'minibuffer-restore-windows)
+
(defun minibuffer-quit-recursive-edit ()
"Quit the command that requested this recursive edit without error.
Like `abort-recursive-edit' without aborting keyboard macro
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 8a4aa2b..3acc187 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3205,7 +3205,7 @@ s Search for keywords M Like m, but
only TODO entries
(delete-window)
(org-agenda-get-restriction-and-command prefix-descriptions))
- ((equal c ?q) (error "Abort"))
+ ((equal c ?q) (user-error "Abort"))
(t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7ed2d3d..542f8ad 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -696,7 +696,7 @@ Each function should return a list of xrefs, or nil; the
first
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -875,7 +875,7 @@ non-nil result supersedes the xrefs produced by
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -893,7 +893,8 @@ non-nil result supersedes the xrefs produced by
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f0180ce..a1f806a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2059,22 +2059,43 @@ for \\[find-tag] (which see)."
If you want `xref-find-definitions' to find the tagged files by their
file name, add `tag-partial-file-name-match-p' to the list value.")
+(defcustom etags-xref-prefer-current-file nil
+ "Non-nil means show the matches in the current file first."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql
etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
+ (let ((file (and buffer-file-name (expand-file-name buffer-file-name)))
+ (definitions (etags--xref-find-definitions symbol))
+ same-file-definitions)
+ (when (and etags-xref-prefer-current-file file)
+ (cl-delete-if
+ (lambda (definition)
+ (when (equal file
+ (xref-location-group
+ (xref-item-location definition)))
+ (push definition same-file-definitions)
+ t))
+ definitions)
+ (setq definitions (nconc (nreverse same-file-definitions)
+ definitions)))
+ definitions))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f49ee4c..4e14c30 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -178,6 +178,14 @@
(defconst perl-font-lock-keywords-2
(append
+ '(;; Fontify function, variable and file name references. They have to be
+ ;; handled first because they might conflict with keywords.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
+ ;; will underline them by default.
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (2 'perl-non-scalar-variable)))
perl-font-lock-keywords-1
`( ;; Fontify keywords, except those fontified otherwise.
,(concat "\\<"
@@ -188,15 +196,6 @@
;;
;; Fontify declarators and prefixes as types.
("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-keyword-face) ;
declarators
- ;;
- ;; Fontify function, variable and file name references.
- ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
- ;; will underline them by default.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
- (2 'perl-non-scalar-variable))
("<\\(\\sw+\\)>" 1 font-lock-constant-face)
;;
;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 0e73286..b710175 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -879,23 +879,16 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project--completing-read-strict (prompt
collection &optional predicate
hist default)
- ;; Tried both expanding the default before showing the prompt, and
- ;; removing it when it has no matches. Neither seems natural
- ;; enough. Removal is confusing; early expansion makes the prompt
- ;; too long.
- (let* ((new-prompt (if (and default (not (string-equal default "")))
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (res (completing-read new-prompt
- collection predicate t
- nil ;; initial-input
- hist default)))
- (when (and (equal res default)
- (not (test-completion res collection predicate)))
- (setq res
- (completing-read (format "%s: " prompt)
- collection predicate t res hist nil)))
- res))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ (let ((minibuffer-default default))
+ (minibuffer-default-add-completions)))))
+ (completing-read (format "%s: " prompt)
+ collection predicate 'confirm
+ nil
+ hist)))
;;;###autoload
(defun project-dired ()
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7453dbe..69378a5 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -657,7 +657,7 @@ quit the *xref* buffer."
(interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
- (user-error "No reference at point")))
+ (user-error "Choose a reference to visit")))
(xref--current-item xref))
(xref--show-location (xref-item-location xref) (if quit 'quit t))
(if (fboundp 'next-error-found)
@@ -1356,7 +1356,9 @@ This command is intended to be bound to a mouse event."
The argument has the same meaning as in `apropos'."
(interactive (list (read-string
"Search for pattern (word list or regexp): "
- nil 'xref--read-pattern-history)))
+ nil 'xref--read-pattern-history
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))))
(require 'apropos)
(let* ((newpat
(if (and (version< emacs-version "28.0.50")
diff --git a/lisp/replace.el b/lisp/replace.el
index 54d652b..ee46286 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1898,6 +1898,7 @@ See also `multi-occur'."
;; Make the default-directory of the *Occur* buffer match that of
;; the buffer where the occurrences come from
(setq default-directory source-buffer-default-directory)
+ (setq overlay-arrow-position nil)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
diff --git a/lisp/simple.el b/lisp/simple.el
index 5ec7fd8..3ad8634 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8143,15 +8143,19 @@ is defined.
The function should take a single optional argument, which is a flag
indicating whether it should use soft newlines.")
-(defun default-indent-new-line (&optional soft)
+(defun default-indent-new-line (&optional soft force)
"Break line at point and indent.
If a comment syntax is defined, call `comment-line-break-function'.
The inserted newline is marked hard if variable `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
- (interactive)
+ (interactive (list nil t))
(if comment-start
- (funcall comment-line-break-function soft)
+ ;; Force breaking the line when called interactively.
+ (if force
+ (let ((comment-auto-fill-only-comments nil))
+ (funcall comment-line-break-function soft))
+ (funcall comment-line-break-function soft))
;; Insert the newline before removing empty space so that markers
;; get preserved better.
(if soft (insert-and-inherit ?\n) (newline 1))
diff --git a/lisp/so-long.el b/lisp/so-long.el
index 829afd6..7bf15e8 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -8,7 +8,7 @@
;; Keywords: convenience
;; Created: 23 Dec 2015
;; Package-Requires: ((emacs "24.4"))
-;; Version: 1.1
+;; Version: 1.1.1
;; This file is part of GNU Emacs.
@@ -410,6 +410,7 @@
;; * Change Log:
;;
+;; 1.1.1 - Identical to 1.1, but fixing an incorrect GNU ELPA release.
;; 1.1 - Utilise `buffer-line-statistics' in Emacs 28+, with the new
;; `so-long-predicate' function `so-long-statistics-excessive-p'.
;; - Increase `so-long-threshold' from 250 to 10,000.
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 4c2470f..5bbf1a8 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -73,8 +73,8 @@ provider functions are called with no parameters at the point
in
question.
\"things\" include `symbol', `list', `sexp', `defun', `filename',
-`url', `email', `uuid', `word', `sentence', `whitespace', `line',
-and `page'.")
+`existing-filename', `url', `email', `uuid', `word', `sentence',
+`whitespace', `line', and `page'.")
;; Basic movement
@@ -156,8 +156,8 @@ positions of the thing found."
"Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
-`line', `number', and `page'.
+`filename', `existing-filename', `url', `email', `uuid', `word',
+`sentence', `whitespace', `line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
@@ -301,6 +301,17 @@ E.g.:
(define-thing-chars filename thing-at-point-file-name-chars)
+;; Files
+
+(defun thing-at-point-file-at-point (&optional _lax _bounds)
+ "Return the name of the existing file at point."
+ (when-let ((filename (thing-at-point 'filename)))
+ (setq filename (expand-file-name filename))
+ (and (file-exists-p filename)
+ filename)))
+
+(put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point)
+
;; URIs
(defvar thing-at-point-beginning-of-url-regexp nil
diff --git a/lisp/url/url.el b/lisp/url/url.el
index a6565e2..ccc95a6 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -235,85 +235,55 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies.
If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up."
(url-do-setup)
-
- (let ((retrieval-done nil)
- (start-time (current-time))
- (url-asynchronous nil)
- (asynch-buffer nil)
- (timed-out nil))
- (setq asynch-buffer
- (url-retrieve url (lambda (&rest ignored)
- (url-debug 'retrieval "Synchronous fetching done
(%S)" (current-buffer))
- (setq retrieval-done t
- asynch-buffer (current-buffer)))
- nil silent inhibit-cookies))
- (if (null asynch-buffer)
- ;; We do not need to do anything, it was a mailto or something
- ;; similar that takes processing completely outside of the URL
- ;; package.
- nil
- (let ((proc (get-buffer-process asynch-buffer)))
- ;; If the access method was synchronous, `retrieval-done' should
- ;; hopefully already be set to t. If it is nil, and `proc' is also
- ;; nil, it implies that the async process is not running in
- ;; asynch-buffer. This happens e.g. for FTP files. In such a case
- ;; url-file.el should probably set something like a `url-process'
- ;; buffer-local variable so we can find the exact process that we
- ;; should be waiting for. In the mean time, we'll just wait for any
- ;; process output.
- (while (and (not retrieval-done)
- (or (not timeout)
- (not (setq timed-out
- (time-less-p timeout
- (time-since start-time))))))
- (url-debug 'retrieval
- "Spinning in url-retrieve-synchronously: %S (%S)"
- retrieval-done asynch-buffer)
- (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
- (setq proc (get-buffer-process
- (setq asynch-buffer
- (buffer-local-value 'url-redirect-buffer
- asynch-buffer))))
- (if (and proc (memq (process-status proc)
- '(closed exit signal failed))
- ;; Make sure another process hasn't been started.
- (eq proc (or (get-buffer-process asynch-buffer) proc)))
- ;; FIXME: It's not clear whether url-retrieve's callback is
- ;; guaranteed to be called or not. It seems that url-http
- ;; decides sometimes consciously not to call it, so it's not
- ;; clear that it's a bug, but even then we need to decide how
- ;; url-http can then warn us that the download has completed.
- ;; In the mean time, we use this here workaround.
- ;; XXX: The callback must always be called. Any
- ;; exception is a bug that should be fixed, not worked
- ;; around.
- (progn ;; Call delete-process so we run any sentinel now.
- (delete-process proc)
- (setq retrieval-done t)))
- ;; We used to use `sit-for' here, but in some cases it wouldn't
- ;; work because apparently pending keyboard input would always
- ;; interrupt it before it got a chance to handle process input.
- ;; `sleep-for' was tried but it lead to other forms of
- ;; hanging. --Stef
- (unless (or (with-local-quit
- (accept-process-output proc 1))
- (null proc))
- ;; accept-process-output returned nil, maybe because the process
- ;; exited (and may have been replaced with another). If we got
- ;; a quit, just stop.
- (when quit-flag
- (delete-process proc))
- (setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer))))))
- ;; On timeouts, make sure we kill any pending processes.
- ;; There may be more than one if we had a redirect.
- (when timed-out
- (when (process-live-p proc)
- (delete-process proc))
- (when-let ((aproc (get-buffer-process asynch-buffer)))
- (when (process-live-p aproc)
- (delete-process aproc))))))
- asynch-buffer))
+ (let* (url-asynchronous
+ data-buffer
+ (callback (lambda (&rest _args)
+ (setq data-buffer (current-buffer))
+ (url-debug 'retrieval
+ "Synchronous fetching done (%S)"
+ data-buffer)))
+ (start-time (current-time))
+ (proc-buffer (url-retrieve url callback nil silent
+ inhibit-cookies)))
+ (if (not proc-buffer)
+ (url-debug 'retrieval "Synchronous fetching unnecessary %s" url)
+ (unwind-protect
+ (catch 'done
+ (while (not data-buffer)
+ (when (and timeout (time-less-p timeout
+ (time-since start-time)))
+ (url-debug 'retrieval "Timed out %s (after %ss)" url
+ (float-time (time-since start-time)))
+ (throw 'done 'timeout))
+ (url-debug 'retrieval
+ "Spinning in url-retrieve-synchronously: nil (%S)"
+ proc-buffer)
+ (when-let ((redirect-buffer
+ (buffer-local-value 'url-redirect-buffer
+ proc-buffer)))
+ (unless (eq redirect-buffer proc-buffer)
+ (url-debug
+ 'retrieval "Redirect in url-retrieve-synchronously: %S ->
%S"
+ proc-buffer redirect-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer))
+ ;; Accommodate hack in commit 55d1d8b.
+ (setq proc-buffer redirect-buffer)))
+ (when-let ((proc (get-buffer-process proc-buffer)))
+ (when (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Process sentinel vagaries occasionally cause
+ ;; url-retrieve to fail calling callback.
+ (unless data-buffer
+ (url-debug 'retrieval "Dead process %s" url)
+ (throw 'done 'exception))))
+ ;; Querying over consumer internet in the US takes 100
+ ;; ms, so split the difference.
+ (accept-process-output nil 0.05)))
+ (unless (eq data-buffer proc-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer)))))
+ data-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 694d452..956d9b3 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -214,6 +214,9 @@ Used in `smerge-diff-base-upper' and related functions."
["Invoke Ediff" smerge-ediff
:help "Use Ediff to resolve the conflicts"
:active (smerge-check 1)]
+ ["Refine" smerge-refine
+ :help "Highlight different words of the conflict"
+ :active (smerge-check 1)]
["Auto Resolve" smerge-resolve
:help "Try auto-resolution heuristics"
:active (smerge-check 1)]
diff --git a/src/Makefile.in b/src/Makefile.in
index 22c7aee..732cd8f 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -326,7 +326,8 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
LIBGMP = @LIBGMP@
-LIBGCCJIT = @LIBGCCJIT_LIB@
+LIBGCCJIT_LIBS = @LIBGCCJIT_LIBS@
+LIBGCCJIT_CFLAGS = @LIBGCCJIT_CFLAGS@
## dynlib.o if necessary, else empty
DYNLIB_OBJ = @DYNLIB_OBJ@
@@ -367,7 +368,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(top_srcdir)/lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
- $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
+ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \
$(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \
$(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
@@ -516,7 +517,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS)
$(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/minibuf.c b/src/minibuf.c
index 0f4349e..c9134ef 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -689,12 +689,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
call1 (Qpush_window_buffer_onto_prev, minibuf_window);
record_unwind_protect_void (minibuffer_unwind);
- record_unwind_protect (restore_window_configuration,
- list3 (Fcurrent_window_configuration (Qnil), Qt, Qt));
+ if (read_minibuffer_restore_windows)
+ record_unwind_protect (restore_window_configuration,
+ list3 (Fcurrent_window_configuration (Qnil),
+ Qt, Qt));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
- if (!EQ (mini_frame, selected_frame))
+ if (read_minibuffer_restore_windows &&
+ !EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
list3 (Fcurrent_window_configuration (mini_frame),
Qnil, Qt));
@@ -2527,6 +2530,19 @@ for instance when running a headless Emacs server.
Functions like
instead. */);
inhibit_interaction = 0;
+ DEFVAR_BOOL ("read-minibuffer-restore-windows",
read_minibuffer_restore_windows,
+ doc: /* Non-nil means restore window configurations on exit from
minibuffer.
+If this is non-nil (the default), reading input with the minibuffer will
+restore, on exit, the window configurations of the frame where the
+minibuffer was entered from and, if it is different, the frame that owns
+the associated minibuffer window.
+
+If this is nil, window configurations are not restored upon exiting
+the minibuffer. However, if `minibuffer-restore-windows' is present
+in `minibuffer-exit-hook', exiting the minibuffer will remove the window
+showing the *Completions* buffer, if any. */);
+ read_minibuffer_restore_windows = true;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
diff --git a/src/xdisp.c b/src/xdisp.c
index 70d15ae..e62f7e3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -15082,11 +15082,12 @@ hscroll_window_tree (Lisp_Object window)
else
{
if (hscroll_relative_p)
- wanted_x = text_area_width * hscroll_step_rel
- + h_margin;
+ wanted_x =
+ text_area_width * hscroll_step_rel + h_margin + x_offset;
else
- wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
- + h_margin;
+ wanted_x =
+ hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ + h_margin + x_offset;
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH
(it.f);
}
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 5aa853c..80003c2 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -432,6 +432,15 @@
(let ((x 2))
(list (or (bytecomp-test-identity 'a) (setq x 3)) x))
+ (mapcar (lambda (b)
+ (let ((a nil))
+ (+ 0
+ (progn
+ (setq a b)
+ (setq b 1)
+ a))))
+ '(10))
+
(let* ((x 1)
(y (condition-case x
(/ 1 0)
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el
b/test/lisp/emacs-lisp/checkdoc-tests.el
index 7a7aa9f..2a1d8b2 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,27 +49,27 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return
A.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun))
(with-temp-buffer
(emacs-lisp-mode)
(insert
- "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return
A.\")")
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return
A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 9312fb4..b48a48f 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -56,7 +56,11 @@
(should (equal (cl--generic-1 'a nil) '(a)))
(should (equal (cl--generic-1 4 nil) '("quatre" 4)))
(should (equal (cl--generic-1 5 nil) '("cinq" 5)))
- (should (equal (cl--generic-1 6 nil) '("six" a))))
+ (should (equal (cl--generic-1 6 nil) '("six" a)))
+ (defvar cl--generic-fooval 41)
+ (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
+ "forty-two")
+ (should (equal (cl--generic-1 42 nil) "forty-two")))
(cl-defstruct cl-generic-struct-parent a b)
(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 3ceb392..f8113bf 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -123,6 +123,25 @@ left alone when opening a URL in an external browser."
(save-excursion (insert "type="))
(ffap-guess-file-name-at-point))))
+(ert-deftest ffap-ido-mode ()
+ (require 'ido)
+ (with-temp-buffer
+ (let ((ido-mode t)
+ (read-file-name-function read-file-name-function)
+ (read-buffer-function read-buffer-function))
+ ;; Says ert-deftest:
+ ;; Macros in BODY are expanded when the test is defined, not when it
+ ;; is run. If a macro (possibly with side effects) is to be tested,
+ ;; it has to be wrapped in `(eval (quote ...))'.
+ (eval (quote (ido-everywhere)))
+ (let ((read-file-name-function (lambda (&rest args)
+ (expand-file-name
+ (nth 4 args)
+ (nth 1 args)))))
+ (save-excursion (insert "ffap-tests.el"))
+ (let (kill-buffer-query-functions)
+ (kill-buffer (call-interactively #'find-file-at-point)))))))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index a5c8236..a612c06 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -316,7 +316,9 @@ be $HOME."
(ert-deftest files-tests-file-name-non-special--subprocess ()
"Check that Bug#25949 and Bug#48177 are fixed."
- (skip-unless (and (executable-find "true") (file-exists-p null-device)))
+ (skip-unless (and (executable-find "true") (file-exists-p null-device)
+ ;; These systems cannot set date of the null device.
+ (not (memq system-type '(windows-nt ms-dos)))))
(let ((default-directory (file-name-quote temporary-file-directory))
(true (file-name-quote (executable-find "true")))
(null (file-name-quote null-device)))
@@ -951,40 +953,51 @@ unquoted file names."
(ert-deftest files-test-auto-save-name-default ()
(with-temp-buffer
- (let ((auto-save-file-name-transforms nil))
+ (let ((auto-save-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
(setq buffer-file-name "/tmp/foo.txt")
- (should (equal (make-auto-save-file-name) "/tmp/#foo.txt#")))))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-transform ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#")))))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-unique ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#")))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#!tmp!foo.txt#")))
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-auto-save-file-name)
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
"/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
(ert-deftest files-test-lock-name-default ()
- (let ((lock-file-name-transforms nil))
- (should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt"))))
+ (let ((lock-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/tmp/.#foo.txt"))))
(ert-deftest files-test-lock-name-unique ()
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#!tmp!foo.txt")))
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
(ert-deftest files-tests-file-name-non-special-make-directory ()
@@ -1448,7 +1461,12 @@ See <https://debbugs.gnu.org/36401>."
(should (equal (parse-colon-path "x:/foo//bar/baz")
'("x:/foo/bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/")))))
+ '("/foo/bar/baz/"))))
+ (let* ((path (concat "." path-separator "/tmp"))
+ (parsed-path (parse-colon-path path))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2)))
+ (should (equal (car parsed-path) "./"))
+ (should (equal (substring (cadr parsed-path) name-start) "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
diff --git a/test/lisp/progmodes/perl-mode-tests.el
b/test/lisp/progmodes/perl-mode-tests.el
index f63f8ad..3f4af5e 100644
--- a/test/lisp/progmodes/perl-mode-tests.el
+++ b/test/lisp/progmodes/perl-mode-tests.el
@@ -21,6 +21,13 @@
(require 'perl-mode)
+(ert-deftest perl-test-lock ()
+ (with-temp-buffer
+ (perl-mode)
+ (insert "$package = foo;")
+ (font-lock-ensure (point-min) (point-max))
+ (should (equal (get-text-property 4 'face)
'font-lock-variable-name-face))))
+
;;;; Re-use cperl-mode tests
(defvar cperl-test-mode)