[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 033e960: Merge remote-tracking branch 'savannah/mast
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 033e960: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sun, 22 Nov 2020 16:58:09 -0500 (EST) |
branch: feature/native-comp
commit 033e96055cc172d8d84adc128aee7f7d9889bb00
Merge: 6781cd6 9b6ad31
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
.gitignore | 1 -
INSTALL | 28 +-
doc/emacs/mule.texi | 6 +
doc/emacs/package.texi | 16 +
doc/lispref/edebug.texi | 8 +-
doc/lispref/help.texi | 5 +-
doc/lispref/minibuf.texi | 10 +
doc/lispref/os.texi | 22 +-
doc/lispref/windows.texi | 7 +-
etc/NEWS | 59 ++-
etc/PROBLEMS | 6 +-
lib-src/etags.c | 36 +-
lib-src/make-fingerprint.c | 9 +-
lisp/allout.el | 11 +-
lisp/calc/calc-aent.el | 35 +-
lisp/calc/calc-alg.el | 7 +-
lisp/calc/calc-arith.el | 10 +-
lisp/calc/calc-ext.el | 38 +-
lisp/calc/calc-forms.el | 2 +-
lisp/calc/calc-frac.el | 5 +-
lisp/calc/calc-funcs.el | 11 +-
lisp/calc/calc-help.el | 50 +-
lisp/calc/calc-lang.el | 364 ++++++-------
lisp/calc/calc-macs.el | 6 +-
lisp/calc/calc-map.el | 43 +-
lisp/calc/calc-misc.el | 11 +-
lisp/calc/calc-mode.el | 2 +-
lisp/calc/calc-mtx.el | 6 +-
lisp/calc/calc-poly.el | 21 +-
lisp/calc/calc-prog.el | 14 +-
lisp/calc/calc-rewr.el | 77 ++-
lisp/calc/calc-store.el | 71 ++-
lisp/calc/calc-stuff.el | 6 +-
lisp/calc/calc-units.el | 40 +-
lisp/calc/calc-vec.el | 18 +-
lisp/calc/calc-yank.el | 11 +-
lisp/calc/calc.el | 11 +-
lisp/calc/calcalg2.el | 583 ++++++++++-----------
lisp/calc/calcalg3.el | 16 +-
lisp/calc/calccomp.el | 117 ++---
lisp/cedet/inversion.el | 6 +-
lisp/cedet/semantic/bovine/el.el | 26 +-
lisp/cedet/semantic/format.el | 11 +-
lisp/cedet/semantic/ia.el | 11 +-
lisp/cedet/semantic/sort.el | 6 +-
lisp/cedet/semantic/symref/grep.el | 22 +-
lisp/cedet/semantic/tag.el | 11 +-
lisp/cus-dep.el | 2 +-
lisp/cus-edit.el | 36 +-
lisp/cus-face.el | 4 +-
lisp/edmacro.el | 51 +-
lisp/emacs-lisp/advice.el | 42 +-
lisp/emacs-lisp/benchmark.el | 2 +-
lisp/emacs-lisp/bytecomp.el | 3 +-
lisp/emacs-lisp/cl-extra.el | 29 +-
lisp/emacs-lisp/cl-macs.el | 26 +-
lisp/emacs-lisp/cl-seq.el | 13 +-
lisp/emacs-lisp/easymenu.el | 1 +
lisp/emacs-lisp/edebug.el | 20 +-
lisp/emacs-lisp/lisp.el | 16 +-
lisp/emacs-lisp/package.el | 46 +-
lisp/emacs-lisp/pp.el | 40 +-
lisp/emacs-lisp/regi.el | 21 +-
lisp/emulation/edt.el | 3 +-
lisp/emulation/viper-util.el | 8 -
lisp/epa.el | 9 +-
lisp/erc/erc-log.el | 3 +-
lisp/erc/erc.el | 4 +-
lisp/eshell/em-basic.el | 9 +-
lisp/eshell/em-cmpl.el | 53 +-
lisp/eshell/em-dirs.el | 5 +-
lisp/eshell/em-hist.el | 19 +-
lisp/eshell/em-ls.el | 76 ++-
lisp/eshell/em-pred.el | 46 +-
lisp/eshell/em-prompt.el | 7 +-
lisp/eshell/em-smart.el | 25 +-
lisp/eshell/em-unix.el | 5 +-
lisp/eshell/esh-arg.el | 79 ++-
lisp/eshell/esh-cmd.el | 32 +-
lisp/eshell/esh-mode.el | 58 +-
lisp/eshell/esh-module.el | 19 +-
lisp/eshell/esh-proc.el | 10 +-
lisp/eshell/esh-var.el | 20 +-
lisp/ffap.el | 45 +-
lisp/files-x.el | 10 +
lisp/files.el | 65 ++-
lisp/filesets.el | 78 ++-
lisp/find-lisp.el | 24 +-
lisp/generic-x.el | 121 ++---
lisp/gnus/gnus-agent.el | 31 +-
lisp/gnus/gnus-art.el | 2 +-
lisp/gnus/gnus-search.el | 9 +-
lisp/gnus/message.el | 2 +-
lisp/gnus/nnmairix.el | 84 ++-
lisp/help.el | 1 +
lisp/ibuf-ext.el | 19 +-
lisp/international/mule-cmds.el | 99 ++--
lisp/international/mule-diag.el | 13 +-
lisp/international/quail.el | 18 +-
lisp/jsonrpc.el | 16 +-
lisp/mail/reporter.el | 14 +-
lisp/mail/supercite.el | 30 +-
lisp/mh-e/mh-alias.el | 31 +-
lisp/mh-e/mh-comp.el | 110 ++--
lisp/mh-e/mh-identity.el | 7 +-
lisp/mh-e/mh-utils.el | 5 +-
lisp/net/dig.el | 6 +-
lisp/net/eudc-bob.el | 12 +-
lisp/net/eudc-export.el | 11 +-
lisp/net/eudc.el | 237 ++++-----
lisp/net/eudcb-bbdb.el | 43 +-
lisp/net/mairix.el | 83 ++-
lisp/net/sieve-mode.el | 2 -
lisp/net/tramp-adb.el | 39 +-
lisp/net/tramp-compat.el | 8 +
lisp/net/tramp-integration.el | 34 +-
lisp/net/tramp-sh.el | 153 ++++--
lisp/net/tramp-smb.el | 4 +-
lisp/net/tramp.el | 14 +-
lisp/newcomment.el | 10 +-
lisp/org/org.el | 28 +-
lisp/password-cache.el | 4 +-
lisp/pcmpl-gnu.el | 30 +-
lisp/play/handwrite.el | 2 +-
lisp/progmodes/cc-langs.el | 2 +-
lisp/progmodes/compile.el | 67 +--
lisp/progmodes/cperl-mode.el | 155 +++---
lisp/progmodes/gdb-mi.el | 48 +-
lisp/progmodes/grep.el | 146 ++++--
lisp/progmodes/idlw-help.el | 21 +-
lisp/progmodes/idlw-shell.el | 62 +--
lisp/progmodes/idlwave.el | 95 ++--
lisp/progmodes/make-mode.el | 6 +-
lisp/progmodes/perl-mode.el | 2 +-
lisp/progmodes/prolog.el | 3 -
lisp/simple.el | 59 ++-
lisp/subr.el | 46 +-
lisp/term.el | 13 +-
lisp/term/w32-win.el | 79 ++-
lisp/textmodes/bibtex.el | 88 ++--
lisp/textmodes/rst.el | 2 -
lisp/textmodes/table.el | 55 +-
lisp/time-stamp.el | 8 +-
lisp/url/url-auth.el | 3 +-
lisp/url/url-http.el | 4 +-
lisp/url/url-news.el | 3 +-
lisp/url/url-proxy.el | 3 +-
lisp/url/url.el | 14 +-
lisp/vc/diff-mode.el | 3 +-
lisp/vc/ediff-wind.el | 13 +-
nt/INSTALL | 18 +
nt/INSTALL.W64 | 12 +-
src/buffer.c | 7 -
src/buffer.h | 3 -
src/data.c | 12 +-
src/dispnew.c | 10 +-
src/fns.c | 23 +-
src/image.c | 45 +-
src/keyboard.c | 14 +-
src/keymap.c | 30 +-
src/minibuf.c | 5 +-
src/term.c | 8 +-
src/termhooks.h | 4 -
src/w32term.c | 16 +-
src/window.c | 21 +-
src/xdisp.c | 18 +-
src/xterm.c | 24 +-
test/lisp/cedet/semantic-utest.el | 7 +-
test/lisp/cus-edit-tests.el | 80 +++
test/lisp/emacs-lisp/bytecomp-tests.el | 32 +-
test/lisp/help-tests.el | 6 +
.../cperl-mode-resources/cperl-bug-26850.pl | 16 +
test/lisp/progmodes/cperl-mode-tests.el | 15 +
test/manual/etags/ETAGS.good_1 | 14 +-
test/manual/etags/ETAGS.good_2 | 14 +-
test/manual/etags/ETAGS.good_3 | 14 +-
test/manual/etags/ETAGS.good_4 | 14 +-
test/manual/etags/ETAGS.good_5 | 14 +-
test/manual/etags/ETAGS.good_6 | 14 +-
test/manual/indent/tcl.tcl | 4 +
test/src/data-tests.el | 50 ++
test/src/fns-tests.el | 7 +
test/src/keymap-tests.el | 81 +++
test/src/syntax-resources/syntax-comments.txt | 26 +
test/src/syntax-tests.el | 66 ++-
185 files changed, 3225 insertions(+), 2807 deletions(-)
diff --git a/.gitignore b/.gitignore
index b152243..e4379d0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -199,7 +199,6 @@ src/bootstrap-emacs
src/emacs
src/emacs-[0-9]*
src/temacs
-src/fingerprint.c
src/dmpstruct.h
src/*.pdmp
diff --git a/INSTALL b/INSTALL
index e880b4e..5909e8c 100644
--- a/INSTALL
+++ b/INSTALL
@@ -117,19 +117,25 @@ ADDITIONAL DISTRIBUTION FILES
* Complex Text Layout support libraries
-On GNU and Unix systems, Emacs needs the optional libraries "m17n-db",
-"libm17n-flt", "libotf" to correctly display such complex scripts as
-Indic and Khmer, and also for scripts that require Arabic shaping
-support (Arabic and Farsi). On some systems, particularly GNU/Linux,
-these libraries may be already present or available as additional
-packages. Note that if there is a separate 'dev' or 'devel' package,
-for use at compilation time rather than run time, you will need that
-as well as the corresponding run time package; typically the dev
-package will contain header files and a library archive. Otherwise,
-you can download the libraries from <https://www.nongnu.org/m17n/>.
+On GNU and Unix systems, Emacs needs optional libraries to correctly
+display such complex scripts as Indic and Khmer, and also for scripts
+that require Arabic shaping support (Arabic and Farsi). If the
+HarfBuzz library is installed, Emacs will build with it and use it for
+this purpose. HarfBuzz is the preferred shaping engine, both on Posix
+hosts and on MS-Windows, so we recommend installing it before building
+Emacs. The alternative for GNU/Linux and Posix systems is to use the
+"m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems,
+particularly GNU/Linux, these libraries may be already present or
+available as additional packages.) Note that if there is a separate
+'dev' or 'devel' package, for use at compilation time rather than run
+time, you will need that as well as the corresponding run time
+package; typically the dev package will contain header files and a
+library archive. On MS-Windows, if HarfBuzz is not available, Emacs
+will use the Uniscribe shaping engine that is part of the OS.
Note that Emacs cannot support complex scripts on a TTY, unless the
-terminal includes such a support.
+terminal includes such a support. However, most modern terminal
+emulators, such as xterm, do support such scripts.
* intlfonts-VERSION.tar.gz
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 72ae769..bf7088d 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -563,6 +563,12 @@ method's keys by defining key bindings in the keymap
returned by the
function @code{quail-translation-keymap}, using @code{define-key}.
@xref{Init Rebinding}.
+ Input methods are inhibited when the text in the buffer is read-only
+for some reason. This is so single-character key bindings work in
+modes that make buffer text or parts of it read-only, such as
+@code{read-only-mode} and @code{image-mode}, even when an input method
+is active.
+
Another facility for typing characters not on your keyboard is by
using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
character based on its Unicode name or code-point; see @ref{Inserting
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 56e8ee1..4981dd5 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -187,6 +187,14 @@ Filter package list by archive
(@code{package-menu-filter-by-archive}).
This prompts for a package archive (e.g., @samp{gnu}), then shows only
packages from that archive.
+@item / d
+@kindex / d @r{(Package Menu)}
+@findex package-menu-filter-by-description
+Filter package list by description
+(@code{package-menu-filter-by-description}). This prompts for a
+regular expression, then shows only packages with descriptions
+matching that regexp.
+
@item / k
@kindex / k @r{(Package Menu)}
@findex package-menu-filter-by-keyword
@@ -194,6 +202,14 @@ Filter package list by keyword
(@code{package-menu-filter-by-keyword}).
This prompts for a keyword (e.g., @samp{games}), then shows only
packages with that keyword.
+@item / N
+@kindex / N @r{(Package Menu)}
+@findex package-menu-filter-by-name-or-description
+Filter package list by name or description
+(@code{package-menu-filter-by-name-or-description}). This prompts for
+a regular expression, then shows only packages with a name or
+description matching that regexp.
+
@item / n
@kindex / n @r{(Package Menu)}
@findex package-menu-filter-by-name
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 6e9ec47..820fdb9 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -425,7 +425,8 @@ arrange to deinstrument it.
@item ?
Display the help message for Edebug (@code{edebug-help}).
-@item C-]
+@item a
+@itemx C-]
Abort one level back to the previous command level
(@code{abort-recursive-edit}).
@@ -446,7 +447,7 @@ Redisplay the most recently known expression result in the
echo area
@item d
Display a backtrace, excluding Edebug's own functions for clarity
-(@code{edebug-backtrace}).
+(@code{edebug-pop-to-backtrace}).
@xref{Backtraces}, for a description of backtraces
and the commands which work on them.
@@ -640,7 +641,8 @@ configuration is the collection of windows and contents
that were in
effect outside of Edebug.
@table @kbd
-@item v
+@item P
+@itemx v
Switch to viewing the outside window configuration
(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug.
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 2fa54e3..90406df 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -676,8 +676,9 @@ If this variable is non-@code{nil}, its value is a form to
evaluate
whenever the character @code{help-char} is read. If evaluating the form
produces a string, that string is displayed.
-A command that calls @code{read-event}, @code{read-char-choice}, or
-@code{read-char} probably should bind @code{help-form} to a
+A command that calls @code{read-event}, @code{read-char-choice},
+@code{read-char}, @code{read-char-from-minibuffer}, or
+@code{y-or-n-p} probably should bind @code{help-form} to a
non-@code{nil} expression while it does input. (The time when you
should not do this is when @kbd{C-h} has some other meaning.)
Evaluating this expression should result in a string that explains
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index b6a3434..f1cfd29 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2109,6 +2109,11 @@ special responses @code{recenter}, @code{scroll-up},
@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
@code{query-replace-map}), this function performs the specified window
recentering or scrolling operation, and poses the question again.
+
+If you bind @code{help-form} (@pxref{Help Functions}) to
+a non-@code{nil} value while calling @code{y-or-n-p}, then pressing
+@code{help-char} causes it to evaluate @code{help-form} and display
+the result. @code{help-char} is automatically added to @var{prompt}.
@end defun
@defun y-or-n-p-with-timeout prompt seconds default
@@ -2317,6 +2322,11 @@ character. Optionally, it ignores any input that is not
a member of
@var{chars}, a list of accepted characters. The @var{history}
argument specifies the history list symbol to use; if it is omitted or
@code{nil}, this function doesn't use the history.
+
+If you bind @code{help-form} (@pxref{Help Functions}) to
+a non-@code{nil} value while calling @code{read-char-from-minibuffer},
+then pressing @code{help-char} causes it to evaluate @code{help-form}
+and display the result.
@end defun
@node Reading a Password
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 2c30d8a..f897cfa 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1077,12 +1077,19 @@ directories in a search path (as found in an
environment variable). Its
value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
@end defvar
+@defun path-separator
+This function returns the connection-local value of variable
+@code{path-separator}. That is @code{";"} for MS systems and a local
+@code{default-directory}, and @code{":"} for Unix and GNU systems, or
+a remote @code{default-directory}.
+@end defun
+
@defun parse-colon-path path
This function takes a search path string such as the value of
the @env{PATH} environment variable, and splits it at the separators,
returning a list of directories. @code{nil} in this list means
the current directory. Although the function's name says
-``colon'', it actually uses the value of @code{path-separator}.
+``colon'', it actually uses the value of variable @code{path-separator}.
@example
(parse-colon-path ":/foo:/bar")
@@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was
started.
@c The value is @code{nil} if Emacs is running under a window system.
@end defvar
+@defvar null-device
+This variable holds the system null device. Its value is
+@code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS
+systems.
+@end defvar
+
+@defun null-device
+This function returns the connection-local value of variable
+@code{null-device}. That is @code{"NUL"} for MS systems and a local
+@code{default-directory}, and @code{"/dev/null"} for Unix and GNU
+systems, or a remote @code{default-directory}.
+@end defun
+
@node User Identification
@section User Identification
@cindex user identification
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 5ec23a9..2d092e1 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -5869,13 +5869,16 @@ which window parameters (if any) are saved by this
function.
@xref{Window Parameters}.
@end defun
-@defun set-window-configuration configuration
+@defun set-window-configuration configuration &optional dont-set-frame
This function restores the configuration of windows and buffers as
specified by @var{configuration}, for the frame that
@var{configuration} was created for, regardless of whether that frame
is selected or not. The argument @var{configuration} must be a value
that was previously returned by @code{current-window-configuration}
-for that frame.
+for that frame. Normally the function also selects the frame which is
+recorded in the configuration, but if @var{dont-set-frame} is
+non-@code{nil}, it leaves selected the frame which was current at the
+start of the function.
If the frame from which @var{configuration} was saved is dead, all
this function does is to restore the value of the variable
diff --git a/etc/NEWS b/etc/NEWS
index 803185f..2cea803 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -103,7 +103,7 @@ unsystematic behavior, which mixed these two is no longer
available.
+++
** 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
+choosing a group, or clicking a button in the "*Help*" buffers when
looking at the doc string of a function that belongs to one of these
groups.
@@ -187,6 +187,11 @@ space characters.
freenode IRC network for years now. Occurrences of "irc.freenode.net"
have been replaced with "chat.freenode.net" throughout Emacs.
++++
+** New functions 'null-device' and 'path-separator'.
+These functions return the connection local value of the respective
+variables. This can be used for remote hosts.
+
* Editing Changes in Emacs 28.1
@@ -203,6 +208,12 @@ This command would previously not redefine values defined
by these
forms, but this command has now been changed to work more like
'eval-defun', and reset the values as specified.
+---
+** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
+'copy-region-blink-delay' specifies a delay to indicate the region
+copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
+a delay to show a paired character to delete.
+
+++
** New command 'undo-redo'.
It undoes previous undo commands, but doesn't record itself as an
@@ -282,7 +293,7 @@ indentation is done using SMIE or with the old ad-hoc code.
When a warning is displayed to the user, the resulting buffer now has
buttons which allow making permanent changes to the treatment of that
warning. Automatic showing of the warning can be disabled (although
-it is still logged to the *Messages* buffer), or the warning can be
+it is still logged to the "*Messages*" buffer), or the warning can be
disabled entirely.
** mspool.el
@@ -471,13 +482,13 @@ tags to be considered as well.
** Gnus
+++
-*** New gnus-search library
+*** New gnus-search library.
A new unified search syntax which can be used across multiple
supported search engines. Set 'gnus-search-use-parsed-queries' to
non-nil to enable.
+++
-*** New value for user option 'smiley-style'
+*** New value for user option 'smiley-style'.
Smileys can now be rendered with emojis instead of small images when
using the new 'emoji' value in 'smiley-style'.
@@ -706,6 +717,16 @@ This file was a compatibility kludge which is no longer
needed.
To revert to the previous behavior,
'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
+** Customize
+
+*** Most customize commands now hide obsolete user options.
+Obsolete user options are no longer shown in the listings produced by
+the commands 'customize', 'customize-group', 'customize-apropos' and
+'customize-changed-options'.
+
+To customize obsolete user options, use 'customize-option' or
+'customize-saved'.
+
** Edebug
+++
@@ -825,12 +846,14 @@ equivalent to '(map (:sym sym))'.
+++
*** New commands to filter the package list.
-The filter command key bindings are as follows:
+The filter commands are bound to the following keys:
key binding
--- -------
/ a package-menu-filter-by-archive
+/ d package-menu-filter-by-description
/ k package-menu-filter-by-keyword
+/ N package-menu-filter-by-name-or-description
/ n package-menu-filter-by-name
/ s package-menu-filter-by-status
/ v package-menu-filter-by-version
@@ -872,7 +895,7 @@ Customize 'gdb-max-source-window-count' to use more than
one window.
Control source file display by 'gdb-display-source-buffer-action'.
+++
-*** The default value of gdb-mi-decode-strings is now t.
+*** The default value of 'gdb-mi-decode-strings' is now t.
This means that the default coding-system is now used to decode strings
and source file names from GDB.
@@ -1141,8 +1164,8 @@ project's root directory, respectively.
** xref
---
-*** Prefix arg of 'xref-goto-xref' quits the *xref* buffer.
-So typing 'C-u RET' in the *xref* buffer quits its window
+*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer.
+So typing 'C-u RET' in the "*xref*" buffer quits its window
before navigating to the selected location.
** json.el
@@ -1305,6 +1328,11 @@ This new command (bound to 'C-c C-l') regenerates the
current hunk.
** Miscellaneous
+---
+*** New user option 'bibtex-unify-case-convert'.
+This new option allows the user to customize how case is converted
+when unifying entries.
+
+++
*** 'format-seconds' can now be used for sub-second times.
The new optional "," parameter has been added, and
@@ -1320,7 +1348,7 @@ buffers. This can be controlled by customizing the
variable
---
*** New user option 'compilation-search-all-directories'.
When doing parallel builds, directories and compilation errors may
-arrive in the *compilation* buffer out-of-order. If this variable is
+arrive in the "*compilation*" buffer out-of-order. If this variable is
non-nil (the default), Emacs will now search backwards in the buffer
for any directory the file with errors may be in. If nil, this won't
be done (and this restores how this previously worked).
@@ -1750,6 +1778,17 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
* Lisp Changes in Emacs 28.1
+++
+** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
+If you bind 'help-form' to a non-nil value while calling these functions,
+then pressing 'C-h' (help-char) causes the function to evaluate 'help-form'
+and display the result.
+
++++
+** 'set-window-configuration' now takes an optional 'dont-set-frame'
+parameter which, when non-nil, instructs the function not to select
+the frame recorded in the configuration.
+
++++
** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
This can be used to control which major modes the minor mode should be
used in.
@@ -1992,7 +2031,7 @@ image API via 'M-x report-emacs-bug'.
--
** On macOS, 's-<left>' and 's-<right>' are now bound to
-'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
+'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
to select previous/next frame are still bound to 's-~' and 's-`'.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 8ed92ab..f24c6f0 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -352,11 +352,11 @@ is the current directory.
*** Set find-function-C-source-directory accordingly.
Once you have installed the source package, for example at
-/home/myself/deb-src/emacs-26.3, add the following line to your
+/home/myself/deb-src/emacs-27.1, add the following line to your
startup file:
(setq find-function-C-source-directory
- "/home/myself/deb-src/emacs-26.3/src/")
+ "/home/myself/deb-src/emacs-27.1/src/")
The installation directory of the Emacs source package will contain
the exact package name and version number of Emacs that is installed
@@ -386,7 +386,7 @@ To get describe-function and similar commands to work, you
can then
add something like the following to your startup file:
(setq find-function-C-source-directory
- "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/")
+ "/usr/src/debug/emacs-27.1-1.fc31.x86_64/src/")
However, the exact directory name will depend on the system, and you
will need to both upgrade source and debug info when your system
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 146cf61..4315771 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -1974,14 +1974,13 @@ make_tag (const char *name, /* tag name, or NULL if
unnamed */
/* Record a tag. */
static void
-pfnote (char *name, bool is_func, char *linestart, ptrdiff_t linelen,
- intmax_t lno, intmax_t cno)
- /* tag name, or NULL if unnamed */
- /* tag is a function */
- /* start of the line where tag is */
- /* length of the line where tag is */
- /* line number */
- /* character number */
+pfnote (char *name, /* tag name, or NULL if unnamed */
+ bool is_func, /* tag is a function */
+ char *linestart, /* start of the line where tag is */
+ ptrdiff_t linelen, /* length of the line where tag is */
+ intmax_t lno, /* line number */
+ intmax_t cno) /* character number */
+
{
register node *np;
@@ -2905,15 +2904,13 @@ static void make_C_tag (bool);
*/
static bool
-consider_token (char *str, ptrdiff_t len, int c, int *c_extp,
- ptrdiff_t bracelev, ptrdiff_t parlev, bool *is_func_or_var)
- /* IN: token pointer */
- /* IN: token length */
- /* IN: first char after the token */
- /* IN, OUT: C extensions mask */
- /* IN: brace level */
- /* IN: parenthesis level */
- /* OUT: function or variable found */
+consider_token (char *str, /* IN: token pointer */
+ ptrdiff_t len, /* IN: token length */
+ int c, /* IN: first char after the token */
+ int *c_extp, /* IN, OUT: C extensions mask */
+ ptrdiff_t bracelev, /* IN: brace level */
+ ptrdiff_t parlev, /* IN: parenthesis level */
+ bool *is_func_or_var) /* OUT: function or variable found */
{
/* When structdef is stagseen, scolonseen, or snone with bracelev > 0,
structtype is the type of the preceding struct-like keyword, and
@@ -3312,9 +3309,8 @@ perhaps_more_input (FILE *inf)
* C syntax and adds them to the list.
*/
static void
-C_entries (int c_ext, FILE *inf)
- /* extension of C */
- /* input file */
+C_entries (int c_ext, /* extension of C */
+ FILE *inf) /* input file */
{
char c; /* latest char read; '\0' for end of line */
char *lp; /* pointer one beyond the character `c' */
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c
index c013d0a..b72ee90 100644
--- a/lib-src/make-fingerprint.c
+++ b/lib-src/make-fingerprint.c
@@ -19,9 +19,12 @@ You should have received a copy of the GNU General Public
License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-/* The arguments given to this program are all the object files that
- go into building GNU Emacs. There is no special search logic to find
- the files. */
+/* The argument given to this program is the initial version of the
+ temacs executable file used when building GNU Emacs. This program computes
+ a digest fingerprint for the executable, and modifies the binary in
+ place, replacing all instances of the existing fingerprint (normally
+ the default fingerprint from libgnu's lib/fingerprint.c) with the
+ new value. With option -r, it just prints the digest. */
#include <config.h>
diff --git a/lisp/allout.el b/lisp/allout.el
index b56071d..a4802a1 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5583,12 +5583,11 @@ used verbatim."
"Return copy of STRING for literal reproduction across LaTeX processing.
Expresses the original characters (including carriage returns) of the
string across LaTeX processing."
- (mapconcat (function
- (lambda (char)
- (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
- (concat "\\char" (number-to-string char) "{}"))
- ((= char ?\n) "\\\\")
- (t (char-to-string char)))))
+ (mapconcat (lambda (char)
+ (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
+ (concat "\\char" (number-to-string char) "{}"))
+ ((= char ?\n) "\\\\")
+ (t (char-to-string char))))
string
""))
;;;_ > allout-latex-verbatim-quote-curr-line ()
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 6c162b5..338f0ea 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -76,8 +76,8 @@
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp
- buf (mapconcat (function (lambda (x)
- (math-format-value x 1000)))
+ buf (mapconcat (lambda (x)
+ (math-format-value x 1000))
alg-exp
" ")
shortbuf buf)
@@ -197,18 +197,17 @@
(calc-language (if (memq calc-language '(nil big))
'flat calc-language))
(calc-dollar-values (mapcar
- (function
- (lambda (x)
- (if (stringp x)
- (progn
- (setq x (math-read-exprs x))
- (if (eq (car-safe x)
- 'error)
- (throw 'calc-error
- (calc-eval-error
- (cdr x)))
- (car x)))
- x)))
+ (lambda (x)
+ (if (stringp x)
+ (progn
+ (setq x (math-read-exprs x))
+ (if (eq (car-safe x)
+ 'error)
+ (throw 'calc-error
+ (calc-eval-error
+ (cdr x)))
+ (car x)))
+ x))
args))
(calc-dollar-used 0)
(res (if (stringp str)
@@ -640,10 +639,10 @@ in Calc algebraic input.")
(math-find-user-tokens (car (car p)))
(setq p (cdr p)))
(setq calc-user-tokens (mapconcat 'identity
- (sort (mapcar 'car math-toks)
- (function (lambda (x y)
- (> (length x)
- (length y)))))
+ (sort (mapcar #'car math-toks)
+ (lambda (x y)
+ (> (length x)
+ (length y))))
"\\|")
calc-last-main-parse-table mtab
calc-last-user-lang-parse-table ltab
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index efb6839..53ca01d 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or
nil)."
(cons (nth 2 expr) math-poly-neg-powers))))
(not (Math-zerop (nth 2 expr)))
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
- (mapcar (function (lambda (x) (math-div x (nth 2 expr))))
+ (mapcar (lambda (x) (math-div x (nth 2 expr)))
p1))))
((and (eq (car expr) 'calcFunc-exp)
(equal math-var '(var e var-e)))
@@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or
nil)."
(defun math-polynomial-base (top-expr &optional pred)
"Find the variable (or sub-expression) which is the base of polynomial expr."
(let ((math-poly-base-pred
- (or pred (function (lambda (base) (math-polynomial-p
- top-expr base))))))
+ (or pred (lambda (base)
+ (math-polynomial-p
+ top-expr base)))))
(or (let ((math-poly-base-const-ok nil))
(math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index ae397c4..c11cecf 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -2390,7 +2390,7 @@
(math-trunc (nth 3 a)))))
((math-provably-integerp a) a)
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec)))
a))
+ (math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2453,7 +2453,7 @@
(math-add (math-floor (nth 3 a)) -1)
(math-floor (nth 3 a)))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-floor x math-floor-prec)))
a))
+ (math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2520,7 +2520,7 @@
(math-ceiling (nth 2 a)))
(math-ceiling (nth 3 a))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
+ (math-map-vec (lambda (x) (math-ceiling x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2573,7 +2573,7 @@
((eq (car a) 'intv)
(math-floor (math-add a '(frac 1 2))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-round x prec))) a))
+ (math-map-vec (lambda (x) (math-round x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2656,7 +2656,7 @@
(calcFunc-scf (nth 2 x) n)
(calcFunc-scf (nth 3 x) n))))
((eq (car x) 'vec)
- (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
+ (math-map-vec (lambda (x) (calcFunc-scf x n)) x))
((math-infinitep x)
x)
(t
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 23248ce..4877fa6 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -678,14 +678,13 @@
(calc-init-prefixes)
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
(define-key calc-mode-map (format "j%c" x) 'calc-select-part)
(define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
(define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
(define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
- (define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
+ (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
"0123456789")
(let ((i ?A))
@@ -711,9 +710,9 @@
(define-key calc-alg-map "\e\177" 'calc-pop-above)
;;;; (Autoloads here)
- (mapc (function (lambda (x)
- (mapcar (function (lambda (func) (autoload func (car x))))
- (cdr x))))
+ (mapc (lambda (x)
+ (mapcar (lambda (func) (autoload func (car x)))
+ (cdr x)))
'(
("calc-alg" calc-has-rules math-defsimplify
@@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element
calc-show-edit-buffer)
))
- (mapcar (function (lambda (x)
- (mapcar (function (lambda (cmd) (autoload cmd (car x)
nil t)))
- (cdr x))))
+ (mapcar (lambda (x)
+ (mapcar (lambda (cmd) (autoload cmd (car x) nil t))
+ (cdr x)))
'(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
- (mapc (function (lambda (v) (set v nil))) calc-local-var-list)
+ (mapc (lambda (v) (set v nil)) calc-local-var-list)
(if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values)))
@@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-stack n 1 t)
(calc-push-list (mapcar #'car entries)
1
- (mapcar (function (lambda (x) (nth 2 x)))
+ (mapcar (lambda (x) (nth 2 x))
entries)))))))
(defvar calc-refreshing-evaltos nil)
@@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
(let* ((calc-z-prefix-msgs nil)
(calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
- (function (lambda (x y) (< (car x) (car y))))))
+ (lambda (x y) (< (car x) (car y)))))
(flags (apply #'logior
- (mapcar (function
- (lambda (k)
- (calc-user-function-classify (car k))))
+ (mapcar (lambda (k)
+ (calc-user-function-classify (car k)))
kmap))))
(if (= (logand flags 8) 0)
(calc-user-function-list kmap 7)
@@ -2633,9 +2631,8 @@ If X is not an error form, return 1."
(let ((rhs (calc-top-n 1)))
(calc-enter-result (- 1 n)
name
- (mapcar (function
- (lambda (x)
- (list func x rhs)))
+ (mapcar (lambda (x)
+ (list func x rhs))
(calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg)
@@ -2644,9 +2641,8 @@ If X is not an error form, return 1."
(cond ((> n 0)
(calc-enter-result n
name
- (mapcar (function
- (lambda (x)
- (list func x)))
+ (mapcar (lambda (x)
+ (list func x))
(calc-top-list-n n))))
((< n 0)
(calc-enter-result 1
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 465d452..39116bf 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
((memq (car n) '(+ - / vec neg))
(math-normalize
(cons (car n)
- (mapcar (function (lambda (x) (math-make-mod x m)))
+ (mapcar (lambda (x) (math-make-mod x m))
(cdr n)))))
((and (eq (car n) '*) (Math-anglep (nth 1 n)))
(math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 86a4808..1d6895c 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -132,9 +132,8 @@
(cond ((Math-ratp a)
a)
((memq (car a) '(cplx polar vec hms date sdev intv mod))
- (cons (car a) (mapcar (function
- (lambda (x)
- (calcFunc-frac x tol)))
+ (cons (car a) (mapcar (lambda (x)
+ (calcFunc-frac x tol))
(cdr a))))
((Math-messy-integerp a)
(math-trunc a))
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 5c179ff..9ee86e7 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -797,12 +797,11 @@
(math-reduce-vec
'math-add
(cons 'vec
- (mapcar (function
- (lambda (c)
- (setq k (1+ k))
- (math-mul (math-mul fac c)
- (math-sub (math-pow x1 k)
- (math-pow x2 k)))))
+ (mapcar (lambda (c)
+ (setq k (1+ k))
+ (math-mul (math-mul fac c)
+ (math-sub (math-pow x1 k)
+ (math-pow x2 k))))
coefs)))
x)))
(math-mul (math-pow 2 n)
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 0b327e8..06b4b96 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
"Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
- (mapc (function (lambda (x) (princ (format
- " %s\n"
- (substitute-command-keys x)))))
+ (mapc (lambda (x)
+ (princ (format
+ " %s\n"
+ (substitute-command-keys x))))
(nreverse (cdr (reverse (cdr (calc-help))))))
- (mapc (function (lambda (prefix)
- (let ((msgs (ignore-errors (funcall prefix))))
- (if (car msgs)
- (princ
- (if (eq (nth 2 msgs) ?v)
- (format-message
- "\n`v' or `V' prefix (vector/matrix) keys:
\n")
- (if (nth 2 msgs)
- (format-message
- "\n`%c' prefix (%s) keys:\n"
- (nth 2 msgs)
- (or (cdr (assq (nth 2 msgs)
- calc-help-long-names))
- (nth 1 msgs)))
- (format "\n%s-modified keys:\n"
- (capitalize (nth 1 msgs)))))))
- (mapcar (function
- (lambda (x)
- (princ (format
- " %s\n"
- (substitute-command-keys x)))))
- (car msgs)))))
+ (mapc (lambda (prefix)
+ (let ((msgs (ignore-errors (funcall prefix))))
+ (if (car msgs)
+ (princ
+ (if (eq (nth 2 msgs) ?v)
+ (format-message
+ "\n`v' or `V' prefix (vector/matrix) keys: \n")
+ (if (nth 2 msgs)
+ (format-message
+ "\n`%c' prefix (%s) keys:\n"
+ (nth 2 msgs)
+ (or (cdr (assq (nth 2 msgs)
+ calc-help-long-names))
+ (nth 1 msgs)))
+ (format "\n%s-modified keys:\n"
+ (capitalize (nth 1 msgs)))))))
+ (mapcar (lambda (x)
+ (princ (format
+ " %s\n"
+ (substitute-command-keys x))))
+ (car msgs))))
'(calc-inverse-prefix-help
calc-hyperbolic-prefix-help
calc-inv-hyp-prefix-help
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index bde5abe..2830694 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -175,20 +175,19 @@
(put 'c 'math-vector-brackets "{}")
(put 'c 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "0x%s" s)
- (if (= r 8) (format "0%s" s)
- (format "%d#%s" r s))))))
+ (lambda (r s)
+ (if (= r 16) (format "0x%s" s)
+ (if (= r 8) (format "0%s" s)
+ (format "%d#%s" r s)))))
(put 'c 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-slash-idiv 'c)
(add-to-list 'calc-lang-allow-underscores 'c)
@@ -238,9 +237,9 @@
(put 'pascal 'math-output-filter 'calc-output-case-filter)
(put 'pascal 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "$%s" s)
- (format "%d#%s" r s)))))
+ (lambda (r s)
+ (if (= r 16) (format "$%s" s)
+ (format "%d#%s" r s))))
(put 'pascal 'math-lang-read-symbol
'((?\$
@@ -253,17 +252,16 @@
math-exp-pos (match-end 1)))))
(put 'pascal 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
- (setq args (append (cdr (cdr (nth 1 a))) args)
- a (nth 1 a)))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
+ (setq args (append (cdr (cdr (nth 1 a))) args)
+ a (nth 1 a)))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-allow-underscores 'pascal)
(add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@@ -350,17 +348,16 @@
math-exp-pos (match-end 0)))))
(put 'fortran 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
- (setq args (append (cdr (cdr (nth 1 a))) args)
- a (nth 1 a)))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "("
- (math-compose-vector args ", " 0)
- ")")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
+ (setq args (append (cdr (cdr (nth 1 a))) args)
+ a (nth 1 a)))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "("
+ (math-compose-vector args ", " 0)
+ ")"))))
(add-to-list 'calc-lang-slash-idiv 'fortran)
(add-to-list 'calc-lang-allow-underscores 'fortran)
@@ -598,18 +595,17 @@
(put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'tex 'math-matrix-formatter
- (function
- (lambda (a)
- (if (and (integerp calc-language-option)
- (or (= calc-language-option 0)
- (> calc-language-option 1)
- (< calc-language-option -1)))
- (append '(vleft 0 "\\matrix{")
- (math-compose-tex-matrix (cdr a))
- '("}"))
- (append '(horiz "\\matrix{ ")
- (math-compose-tex-matrix (cdr a))
- '(" }"))))))
+ (lambda (a)
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\matrix{")
+ (math-compose-tex-matrix (cdr a))
+ '("}"))
+ (append '(horiz "\\matrix{ ")
+ (math-compose-tex-matrix (cdr a))
+ '(" }")))))
(put 'tex 'math-var-formatter 'math-compose-tex-var)
@@ -839,18 +835,17 @@
(put 'latex 'math-complex-format 'i)
(put 'latex 'math-matrix-formatter
- (function
- (lambda (a)
- (if (and (integerp calc-language-option)
- (or (= calc-language-option 0)
- (> calc-language-option 1)
- (< calc-language-option -1)))
- (append '(vleft 0 "\\begin{pmatrix}")
- (math-compose-tex-matrix (cdr a) t)
- '("\\end{pmatrix}"))
- (append '(horiz "\\begin{pmatrix} ")
- (math-compose-tex-matrix (cdr a) t)
- '(" \\end{pmatrix}"))))))
+ (lambda (a)
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\begin{pmatrix}")
+ (math-compose-tex-matrix (cdr a) t)
+ '("\\end{pmatrix}"))
+ (append '(horiz "\\begin{pmatrix} ")
+ (math-compose-tex-matrix (cdr a) t)
+ '(" \\end{pmatrix}")))))
(put 'latex 'math-var-formatter 'math-compose-tex-var)
@@ -1023,36 +1018,34 @@
(put 'eqn 'math-evalto '("evalto " . " -> "))
(put 'eqn 'math-matrix-formatter
- (function
- (lambda (a)
- (append '(horiz "matrix { ")
- (math-compose-eqn-matrix
- (cdr (math-transpose a)))
- '("}")))))
+ (lambda (a)
+ (append '(horiz "matrix { ")
+ (math-compose-eqn-matrix
+ (cdr (math-transpose a)))
+ '("}"))))
(put 'eqn 'math-var-formatter
- (function
- (lambda (a prec)
- (let (v)
- (if (and math-compose-hash-args
- (let ((p calc-arg-values))
- (setq v 1)
- (while (and p (not (equal (car p) a)))
- (setq p (and (eq math-compose-hash-args t) (cdr p))
- v (1+ v)))
- p))
- (if (eq math-compose-hash-args 1)
- "#"
- (format "#%d" v))
- (if (string-match ".'\\'" (symbol-name (nth 2 a)))
- (math-compose-expr
- (list 'calcFunc-Prime
- (list
- 'var
- (intern (substring (symbol-name (nth 1 a)) 0 -1))
- (intern (substring (symbol-name (nth 2 a)) 0 -1))))
- prec)
- (symbol-name (nth 1 a))))))))
+ (lambda (a prec)
+ (let (v)
+ (if (and math-compose-hash-args
+ (let ((p calc-arg-values))
+ (setq v 1)
+ (while (and p (not (equal (car p) a)))
+ (setq p (and (eq math-compose-hash-args t) (cdr p))
+ v (1+ v)))
+ p))
+ (if (eq math-compose-hash-args 1)
+ "#"
+ (format "#%d" v))
+ (if (string-match ".'\\'" (symbol-name (nth 2 a)))
+ (math-compose-expr
+ (list 'calcFunc-Prime
+ (list
+ 'var
+ (intern (substring (symbol-name (nth 1 a)) 0 -1))
+ (intern (substring (symbol-name (nth 2 a)) 0 -1))))
+ prec)
+ (symbol-name (nth 1 a)))))))
(defconst math-eqn-special-funcs
'( calcFunc-log
@@ -1065,31 +1058,30 @@
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
(put 'eqn 'math-func-formatter
- (function
- (lambda (func a)
- (let (left right)
- (if (string-match "[^']'+\\'" func)
- (let ((n (- (length func) (match-beginning 0) 1)))
- (setq func (substring func 0 (- n)))
- (while (>= (setq n (1- n)) 0)
- (setq func (concat func " prime")))))
- (cond ((or (> (length a) 2)
- (not (math-tex-expr-is-flat (nth 1 a))))
- (setq left "{left ( "
- right " right )}"))
-
- ((and
- (memq (car a) math-eqn-special-funcs)
- (= (length a) 2)
- (or (Math-realp (nth 1 a))
- (memq (car (nth 1 a)) '(var *))))
- (setq left "~{" right "}"))
- (t
- (setq left " ( "
- right " )")))
- (list 'horiz func left
- (math-compose-vector (cdr a) " , " 0)
- right)))))
+ (lambda (func a)
+ (let (left right)
+ (if (string-match "[^']'+\\'" func)
+ (let ((n (- (length func) (match-beginning 0) 1)))
+ (setq func (substring func 0 (- n)))
+ (while (>= (setq n (1- n)) 0)
+ (setq func (concat func " prime")))))
+ (cond ((or (> (length a) 2)
+ (not (math-tex-expr-is-flat (nth 1 a))))
+ (setq left "{left ( "
+ right " right )}"))
+
+ ((and
+ (memq (car a) math-eqn-special-funcs)
+ (= (length a) 2)
+ (or (Math-realp (nth 1 a))
+ (memq (car (nth 1 a)) '(var *))))
+ (setq left "~{" right "}"))
+ (t
+ (setq left " ( "
+ right " )")))
+ (list 'horiz func left
+ (math-compose-vector (cdr a) " , " 0)
+ right))))
(put 'eqn 'math-lang-read-symbol
'((?\"
@@ -1111,23 +1103,22 @@
("above" punc ",")))
(put 'eqn 'math-lang-adjust-words
- (function
- (lambda ()
- (let ((code (assoc math-expr-data math-eqn-ignore-words)))
- (cond ((null code))
- ((null (cdr code))
- (math-read-token))
- ((consp (nth 1 code))
- (math-read-token)
- (if (assoc math-expr-data (cdr code))
- (setq math-expr-data (format "%s %s"
- (car code) math-expr-data))))
- ((eq (nth 1 code) 'punc)
- (setq math-exp-token 'punc
- math-expr-data (nth 2 code)))
- (t
- (math-read-token)
- (math-read-token)))))))
+ (lambda ()
+ (let ((code (assoc math-expr-data math-eqn-ignore-words)))
+ (cond ((null code))
+ ((null (cdr code))
+ (math-read-token))
+ ((consp (nth 1 code))
+ (math-read-token)
+ (if (assoc math-expr-data (cdr code))
+ (setq math-expr-data (format "%s %s"
+ (car code) math-expr-data))))
+ ((eq (nth 1 code) 'punc)
+ (setq math-exp-token 'punc
+ math-expr-data (nth 2 code)))
+ (t
+ (math-read-token)
+ (math-read-token))))))
(put 'eqn 'math-lang-read
'((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@@ -1357,14 +1348,13 @@
( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
(put 'yacas 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
@@ -1600,24 +1590,22 @@
(add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
(put 'maxima 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(put 'maxima 'math-matrix-formatter
- (function
- (lambda (a)
- (list 'horiz
- "matrix("
- (math-compose-vector (cdr a)
- (concat math-comp-comma " ")
- math-comp-vector-prec)
- ")"))))
+ (lambda (a)
+ (list 'horiz
+ "matrix("
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ ")")))
;;; Giac
@@ -1806,15 +1794,14 @@ order to Calc's."
(add-to-list 'calc-lang-allow-underscores 'giac)
(put 'giac 'math-compose-subscr
- (function
- (lambda (a)
- ;; (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-expr
- (calc-normalize (list '- (nth 2 a) 1)) 0)
- "]")))) ;;)
+ (lambda (a)
+ ;; (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-expr
+ (calc-normalize (list '- (nth 2 a) 1)) 0)
+ "]"))) ;;)
(defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@@ -1932,7 +1919,7 @@ order to Calc's."
(put 'math 'math-function-close "]")
(put 'math 'math-radix-formatter
- (function (lambda (r s) (format "%d^^%s" r s))))
+ (lambda (r s) (format "%d^^%s" r s)))
(put 'math 'math-lang-read
'((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@@ -1942,13 +1929,12 @@ order to Calc's."
math-exp-pos (match-end 0))))
(put 'math 'math-compose-subscr
- (function
- (lambda (a)
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "[["
- (math-compose-expr (nth 2 a) 0)
- "]]"))))
+ (lambda (a)
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "[["
+ (math-compose-expr (nth 2 a) 0)
+ "]]")))
(defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@@ -2038,26 +2024,24 @@ order to Calc's."
(put 'maple 'math-complex-format 'I)
(put 'maple 'math-matrix-formatter
- (function
- (lambda (a)
- (list 'horiz
- "matrix("
- math-comp-left-bracket
- (math-compose-vector (cdr a)
- (concat math-comp-comma " ")
- math-comp-vector-prec)
- math-comp-right-bracket
- ")"))))
+ (lambda (a)
+ (list 'horiz
+ "matrix("
+ math-comp-left-bracket
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ math-comp-right-bracket
+ ")")))
(put 'maple 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-allow-underscores 'maple)
(add-to-list 'calc-lang-brackets-are-subscripts 'maple)
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 5aaa5f4..06ef3ef 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -33,12 +33,12 @@
(defmacro calc-wrapper (&rest body)
- `(calc-do (function (lambda ()
- ,@body))))
+ `(calc-do (lambda ()
+ ,@body)))
(defmacro calc-slow-wrapper (&rest body)
`(calc-do
- (function (lambda () ,@body)) (point)))
+ (lambda () ,@body) (point)))
(defmacro math-showing-full-precision (form)
`(let ((calc-float-format calc-full-float-format))
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 0ee8282..3e2869d 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -612,14 +612,13 @@
"()")
minibuffer-local-map
t)))
- (setq math-arglist (mapcar (function
- (lambda (x)
- (list 'var
- x
- (intern
- (concat
- "var-"
- (symbol-name x))))))
+ (setq math-arglist (mapcar (lambda (x)
+ (list 'var
+ x
+ (intern
+ (concat
+ "var-"
+ (symbol-name x)))))
math-arglist))))
(setq oper (list "$"
(length math-arglist)
@@ -962,12 +961,12 @@
(apply 'calcFunc-mapeqp func args)))
(defun calcFunc-mapeqr (func &rest args)
- (setq args (mapcar (function (lambda (x)
- (let ((func (assq (car-safe x)
- calc-tweak-eqn-table)))
- (if func
- (cons (nth 1 func) (cdr x))
- x))))
+ (setq args (mapcar (lambda (x)
+ (let ((func (assq (car-safe x)
+ calc-tweak-eqn-table)))
+ (if func
+ (cons (nth 1 func) (cdr x))
+ x)))
args))
(apply 'calcFunc-mapeqp func args))
@@ -1092,28 +1091,28 @@
(defun calcFunc-reducea (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+ (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr vec)))
(calcFunc-reducer func vec)))
(defun calcFunc-rreducea (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+ (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr vec)))
(calcFunc-rreducer func vec)))
(defun calcFunc-reduced (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+ (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr (math-transpose vec))))
(calcFunc-reducer func vec)))
(defun calcFunc-rreduced (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+ (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr (math-transpose vec))))
(calcFunc-rreducer func vec)))
@@ -1216,10 +1215,10 @@
(let ((mat nil))
(while (setq a (cdr a))
(setq mat (cons (cons 'vec
- (mapcar (function (lambda (x)
- (math-build-call func
- (list (car a)
- x))))
+ (mapcar (lambda (x)
+ (math-build-call func
+ (list (car a)
+ x)))
(cdr b)))
mat)))
(math-normalize (cons 'vec (nreverse mat)))))
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 2db09e2..ada754a 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K;
initially C-x * C).
"Create another, independent Calculator buffer."
(interactive)
(if (eq major-mode 'calc-mode)
- (mapc (function
- (lambda (v)
- (set-default v (symbol-value v)))) calc-local-var-list))
+ (mapc (lambda (v)
+ (set-default v (symbol-value v)))
+ calc-local-var-list))
(set-buffer (generate-new-buffer "*Calculator*"))
(pop-to-buffer (current-buffer))
(calc-mode))
@@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K;
initially C-x * C).
;;;###autoload
(defun calc-do-handle-whys ()
(setq calc-why (sort calc-next-why
- (function
- (lambda (x y)
- (and (eq (car x) '*) (not (eq (car y) '*))))))
+ (lambda (x y)
+ (and (eq (car x) '*) (not (eq (car y) '*)))))
calc-next-why nil)
(if (and calc-why (or (eq calc-auto-why t)
(and (eq (car (car calc-why)) '*)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index e109233..358854b 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -268,7 +268,7 @@
(interactive)
(calc-wrapper
(let (pos
- (vals (mapcar (function (lambda (v) (symbol-value (car v))))
+ (vals (mapcar (lambda (v) (symbol-value (car v)))
calc-mode-var-list)))
(unless calc-settings-file
(error "No `calc-settings-file' specified"))
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index 8deef7d..bfcd61d 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -55,7 +55,7 @@
(defun math-col-matrix (a)
(if (and (Math-vectorp a)
(not (math-matrixp a)))
- (cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a)))
+ (cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
a))
@@ -79,8 +79,8 @@
(cons 'vec (nreverse mat))))
(defun math-mul-mat-vec (a b)
- (cons 'vec (mapcar (function (lambda (row)
- (math-dot-product row b)))
+ (cons 'vec (mapcar (lambda (row)
+ (math-dot-product row b))
(cdr a))))
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index b3f2c96..5928a8e 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -202,7 +202,7 @@
(if (memq (car-safe expr) '(+ -))
(math-list-to-sum
(sort (math-sum-to-list expr)
- (function (lambda (a b) (math-beforep (car a) (car b))))))
+ (lambda (a b) (math-beforep (car a) (car b)))))
expr))
(defun math-list-to-sum (lst)
@@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
lst
(if (eq a -1)
(math-mul-list lst a)
- (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))))
+ (mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
(defun math-mul-list (lst a)
(if (eq a 1)
@@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
(if (eq a -1)
(mapcar 'math-neg lst)
(and (not (eq a 0))
- (mapcar (function (lambda (x) (math-mul x a))) lst)))))
+ (mapcar (lambda (x) (math-mul x a)) lst)))))
;;; Run GCD on all elements in a list.
(defun math-poly-gcd-list (lst)
@@ -502,10 +502,10 @@ Take the base that has the highest degree considering
both a and b.
(defun math-sort-poly-base-list (lst)
"Sort a list of polynomial bases."
- (sort lst (function (lambda (a b)
- (or (> (nth 1 a) (nth 1 b))
- (and (= (nth 1 a) (nth 1 b))
- (math-beforep (car a) (car b))))))))
+ (sort lst (lambda (a b)
+ (or (> (nth 1 a) (nth 1 b))
+ (and (= (nth 1 a) (nth 1 b))
+ (math-beforep (car a) (car b)))))))
;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@@ -1033,10 +1033,9 @@ If no partial fraction representation can be found,
return nil."
(math-transpose
(cons 'vec
(mapcar
- (function
- (lambda (x)
- (cons 'vec (math-padded-polynomial
- x var tdeg))))
+ (lambda (x)
+ (cons 'vec (math-padded-polynomial
+ x var tdeg)))
(cdr eqns))))))
(and (math-vectorp eqns)
(let ((res 0)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index ea9c497..781ba5c 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -182,7 +182,7 @@
odef key keyname cmd cmd-base cmd-base-default
func calc-user-formula-alist is-symb)
(if is-lambda
- (setq math-arglist (mapcar (function (lambda (x) (nth 1 x)))
+ (setq math-arglist (mapcar (lambda (x) (nth 1 x))
(nreverse (cdr (reverse (cdr form)))))
form (nth (1- (length form)) form))
(calc-default-formula-arglist form)
@@ -290,10 +290,10 @@
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
(setq calc-user-formula-alist
- (mapcar (function (lambda (x)
- (or (cdr (assq x '((nil . arg-nil)
- (t . arg-t))))
- x))) calc-user-formula-alist))
+ (mapcar (lambda (x)
+ (or (cdr (assq x '((nil . arg-nil)
+ (t . arg-t))))
+ x)) calc-user-formula-alist))
(if cmd
(progn
(require 'calc-macs)
@@ -319,8 +319,8 @@
(append
(list 'lambda calc-user-formula-alist)
(and is-symb
- (mapcar (function (lambda (v)
- (list 'math-check-const v t)))
+ (mapcar (lambda (v)
+ (list 'math-check-const v t))
calc-user-formula-alist))
(list body))))
(put func 'calc-user-defn form)
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 2cc7b6b..1528e12 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -181,19 +181,18 @@
(calc-line-numbering nil)
(calc-show-selections t)
(calc-why nil)
- (math-mt-func (function
- (lambda (x)
- (let ((result (math-apply-rewrites x (cdr crules)
- heads crules)))
- (if result
- (progn
- (if trace-buffer
- (let ((fmt (math-format-stack-value
- (list result nil nil))))
- (with-current-buffer trace-buffer
- (insert "\nrewrite to\n" fmt "\n"))))
- (setq heads (math-rewrite-heads result heads
t))))
- result)))))
+ (math-mt-func (lambda (x)
+ (let ((result (math-apply-rewrites x (cdr crules)
+ heads crules)))
+ (if result
+ (progn
+ (if trace-buffer
+ (let ((fmt (math-format-stack-value
+ (list result nil nil))))
+ (with-current-buffer trace-buffer
+ (insert "\nrewrite to\n" fmt "\n"))))
+ (setq heads (math-rewrite-heads result heads
t))))
+ result))))
(if trace-buffer
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil
nil))))
(with-current-buffer trace-buffer
@@ -485,8 +484,8 @@
(let ((math-rewrite-whole t))
(cdr (math-compile-rewrites (cons
'vec
- (mapcar (function (lambda (x)
- (list 'vec x t)))
+ (mapcar (lambda (x)
+ (list 'vec x t))
(if (eq (car-safe pats) 'vec)
(cdr pats)
(list pats)))))))))
@@ -656,15 +655,14 @@
nil
(nreverse
(mapcar
- (function
- (lambda (v)
- (and (car v)
- (list
- 'calcFunc-assign
- (math-build-var-name
- (car v))
- (math-rwcomp-register-expr
- (nth 1 v))))))
+ (lambda (v)
+ (and (car v)
+ (list
+ 'calcFunc-assign
+ (math-build-var-name
+ (car v))
+ (math-rwcomp-register-expr
+ (nth 1 v)))))
math-regs))))
(math-rwcomp-match-vars math-rhs))
math-remembering)
@@ -672,7 +670,7 @@
(let* ((heads (math-rewrite-heads math-pattern))
(rule (list (vconcat
(nreverse
- (mapcar (function (lambda (x) (nth 3 x)))
+ (mapcar (lambda (x) (nth 3 x))
math-regs)))
math-prog
heads
@@ -724,10 +722,9 @@
(setq rules (cdr rules)))
(if nil-rules
(setq rule-set (cons (cons nil nil-rules) rule-set)))
- (setq all-heads (mapcar 'car
- (sort all-heads (function
- (lambda (x y)
- (< (cdr x) (cdr y)))))))
+ (setq all-heads (mapcar #'car
+ (sort all-heads (lambda (x y)
+ (< (cdr x) (cdr y))))))
(let ((set rule-set)
rule heads ptr)
(while set
@@ -790,15 +787,14 @@
(math-rewrite-heads-rec (car expr)))))))
(defun math-parse-schedule (sched)
- (mapcar (function
- (lambda (s)
- (if (integerp s)
- s
- (if (math-vectorp s)
- (math-parse-schedule (cdr s))
- (if (eq (car-safe s) 'var)
- (math-var-to-calcFunc s)
- (error "Improper component in rewrite schedule"))))))
+ (mapcar (lambda (s)
+ (if (integerp s)
+ s
+ (if (math-vectorp s)
+ (math-parse-schedule (cdr s))
+ (if (eq (car-safe s) 'var)
+ (math-var-to-calcFunc s)
+ (error "Improper component in rewrite schedule")))))
sched))
(defun math-rwcomp-match-vars (expr)
@@ -1180,9 +1176,8 @@
(list 'calcFunc-register
reg2))))
(math-rwcomp-pattern (car arg2) (cdr arg2))))
- (let* ((args (mapcar (function
- (lambda (x)
- (cons x (math-rwcomp-best-reg x))))
+ (let* ((args (mapcar (lambda (x)
+ (cons x (math-rwcomp-best-reg x)))
(cdr expr)))
(args2 (copy-sequence args))
(argp (reverse args2))
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index a1e385c..8f83f34 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -168,15 +168,13 @@
()
(setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
(define-key calc-var-name-map " " 'self-insert-command)
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
- 'calcVar-digit)))
+ 'calcVar-digit))
"0123456789")
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
- 'calcVar-oper)))
+ 'calcVar-oper))
"+-*/^|"))
(defvar calc-store-opers)
@@ -324,10 +322,9 @@
(calc-pop-push-record
(1+ calc-given-value-flag)
(concat "=" (calc-var-name (car (car var))))
- (let ((saved-val (mapcar (function
- (lambda (v)
- (and (boundp (car v))
- (symbol-value (car v)))))
+ (let ((saved-val (mapcar (lambda (v)
+ (and (boundp (car v))
+ (symbol-value (car v))))
var)))
(unwind-protect
(let ((vv var))
@@ -597,13 +594,12 @@
calc-settings-file)))
(if var
(calc-insert-permanent-variable var)
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (calc-insert-permanent-variable x))))))
+ (mapatoms (lambda (x)
+ (and (string-match "\\`var-" (symbol-name x))
+ (not (memq x calc-dont-insert-variables))
+ (calc-var-value x)
+ (not (eq (car-safe (symbol-value x)) 'special-const))
+ (calc-insert-permanent-variable x)))))
(save-buffer))))
@@ -638,27 +634,26 @@
(defun calc-insert-variables (buf)
(interactive "bBuffer in which to save variable values: ")
(with-current-buffer buf
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (or (not (eq x 'var-Decls))
- (not (equal var-Decls '(vec))))
- (or (not (eq x 'var-Holidays))
- (not (equal var-Holidays '(vec (var sat var-sat)
- (var sun var-sun)))))
- (insert "(setq "
- (symbol-name x)
- " "
- (prin1-to-string
- (let ((calc-language
- (if (memq calc-language '(nil big))
- 'flat
- calc-language)))
- (math-format-value (symbol-value x) 100000)))
- ")\n")))))))
+ (mapatoms (lambda (x)
+ (and (string-match "\\`var-" (symbol-name x))
+ (not (memq x calc-dont-insert-variables))
+ (calc-var-value x)
+ (not (eq (car-safe (symbol-value x)) 'special-const))
+ (or (not (eq x 'var-Decls))
+ (not (equal var-Decls '(vec))))
+ (or (not (eq x 'var-Holidays))
+ (not (equal var-Holidays '(vec (var sat var-sat)
+ (var sun var-sun)))))
+ (insert "(setq "
+ (symbol-name x)
+ " "
+ (prin1-to-string
+ (let ((calc-language
+ (if (memq calc-language '(nil big))
+ 'flat
+ calc-language)))
+ (math-format-value (symbol-value x) 100000)))
+ ")\n"))))))
(defun calc-assign (arg)
(interactive "P")
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 58b81fa..8df2ed9 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
math-eval-rules-cache-tag t
math-format-date-cache nil
math-holidays-cache-tag t)
- (mapc (function (lambda (x) (set x -100))) math-cache-list)
+ (mapc (lambda (x) (set x -100)) math-cache-list)
(unless inhibit-msg
(message "All internal calculator caches have been reset"))))
@@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the
stack."
(t (list 'calcFunc-clean a)))))
(defun calcFunc-pclean (a &optional prec)
- (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
+ (math-map-over-constants (lambda (x) (calcFunc-clean x prec))
a))
(defun calcFunc-pfloat (a)
(math-map-over-constants 'math-float a))
(defun calcFunc-pfrac (a &optional tol)
- (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
+ (math-map-over-constants (lambda (x) (calcFunc-frac x tol))
a))
;; The variable math-moc-func is local to math-map-over-constants,
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 709c09e..742b2bb 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table
instead."
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
- (setq tab (mapcar (function
- (lambda (x)
- (list (car x)
- (and (nth 1 x)
- (if (stringp (nth 1 x))
- (let ((exp (math-read-plain-expr
- (nth 1 x))))
- (if (eq (car-safe exp) 'error)
- (error "Format error in
definition of %s in units table: %s"
- (car x) (nth 2 exp))
- exp))
- (nth 1 x)))
- (nth 2 x)
- (nth 3 x)
- (and (not (nth 1 x))
- (list (cons (car x) 1)))
- (nth 4 x))))
+ (setq tab (mapcar (lambda (x)
+ (list (car x)
+ (and (nth 1 x)
+ (if (stringp (nth 1 x))
+ (let ((exp (math-read-plain-expr
+ (nth 1 x))))
+ (if (eq (car-safe exp) 'error)
+ (error "Format error in
definition of %s in units table: %s"
+ (car x) (nth 2 exp))
+ exp))
+ (nth 1 x)))
+ (nth 2 x)
+ (nth 3 x)
+ (and (not (nth 1 x))
+ (list (cons (car x) 1)))
+ (nth 4 x)))
combined-units))
(let ((math-units-table tab))
(mapc #'math-find-base-units tab))
@@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table
instead."
(setq math-decompose-units-cache
(cons entry
(sort ulist
- (function
- (lambda (x y)
- (not (Math-lessp (nth 1 x)
- (nth 1 y))))))))))
+ (lambda (x y)
+ (not (Math-lessp (nth 1 x)
+ (nth 1 y)))))))))
(cdr math-decompose-units-cache))))
(defun math-decompose-unit-part (unit)
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 8754145..036f08e 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -744,7 +744,7 @@
;;; Get the Nth row of a matrix.
(defun calcFunc-mrow (mat n) ; [Public]
(if (Math-vectorp n)
- (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
+ (math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
(if (and (eq (car-safe n) 'intv) (math-constp n))
(calcFunc-subvec mat
(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@@ -768,15 +768,15 @@
;;; Get the Nth column of a matrix.
(defun math-mat-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat))))
+ (cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
(defun calcFunc-mcol (mat n) ; [Public]
(if (Math-vectorp n)
(calcFunc-trn
- (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
+ (math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
(if (and (eq (car-safe n) 'intv) (math-constp n))
(if (math-matrixp mat)
- (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
+ (math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
(calcFunc-mrow mat n))
(or (and (integerp (setq n (math-check-integer n)))
(> n 0))
@@ -804,7 +804,7 @@
;;; Remove the Nth column from a matrix.
(defun math-mat-less-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
+ (cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
(cdr mat))))
(defun calcFunc-mrcol (mat n) ; [Public]
@@ -939,10 +939,10 @@
(calcFunc-idn a (1- (length m)))
(if (math-vectorp m)
(if (math-zerop a)
- (cons 'vec (mapcar (function (lambda (x)
- (if (math-vectorp x)
- (math-mimic-ident a x)
- a)))
+ (cons 'vec (mapcar (lambda (x)
+ (if (math-vectorp x)
+ (math-mimic-ident a x)
+ a))
(cdr m)))
(math-dimension-error))
(calcFunc-idn a))))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e03c002..6186df7 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -643,12 +643,11 @@ Interactively, reads the register using
`register-read-with-preview'."
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
- (function (lambda (x)
- (math-format-flat-expr x 0)))
- (function
- (lambda (x)
- (if (math-vectorp x) (setq allow-ret t))
- (math-format-nice-expr x (frame-width)))))
+ (lambda (x)
+ (math-format-flat-expr x 0))
+ (lambda (x)
+ (if (math-vectorp x) (setq allow-ret t))
+ (math-format-nice-expr x (frame-width))))
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 5716189..9d869f3 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
(defun calc-mode-var-list-restore-default-values ()
"Restore the default values of the variables in `calc-mode-var-list'."
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
+ (mapcar (lambda (v) (set (car v) (nth 1 v)))
calc-mode-var-list))
(defun calc-mode-var-list-restore-saved-values ()
@@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
newvarlist)))
(setq varlist (cdr varlist)))))))
(if newvarlist
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
+ (mapcar (lambda (v) (set (car v) (nth 1 v)))
newvarlist)
(calc-mode-var-list-restore-default-values))))
@@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map}
"
(interactive)
- (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
- (lambda (v) (set-default v (symbol-value v))))
+ (mapc (lambda (v)
+ ;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
+ (set-default v (symbol-value v)))
calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
@@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means."
(let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
(if tail (setcdr tail nil)))
(setq calc-redo-list nil))))
- (mapc (function (lambda (v) (set-default v (symbol-value v))))
+ (mapc (lambda (v) (set-default v (symbol-value v)))
calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 7894bd9..bf4d626 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -361,175 +361,175 @@
res))))
(put 'calcFunc-inv\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
+ (lambda (u) (math-neg (math-div 1 (math-sqr u)))))
(put 'calcFunc-sqrt\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
+ (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
(put 'calcFunc-deg\' 'math-derivative-1
- (function (lambda (_) (math-div-float '(float 18 1) (math-pi)))))
+ (lambda (_) (math-div-float '(float 18 1) (math-pi))))
(put 'calcFunc-rad\' 'math-derivative-1
- (function (lambda (_) (math-pi-over-180))))
+ (lambda (_) (math-pi-over-180)))
(put 'calcFunc-ln\' 'math-derivative-1
- (function (lambda (u) (math-div 1 u))))
+ (lambda (u) (math-div 1 u)))
(put 'calcFunc-log10\' 'math-derivative-1
- (function (lambda (u)
- (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
- u))))
+ (lambda (u)
+ (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
+ u)))
(put 'calcFunc-lnp1\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-add u 1)))))
+ (lambda (u) (math-div 1 (math-add u 1))))
(put 'calcFunc-log\' 'math-derivative-2
- (function (lambda (x b)
- (and (not (Math-zerop b))
- (let ((lnv (math-normalize
- (list 'calcFunc-ln b))))
- (math-div 1 (math-mul lnv x)))))))
+ (lambda (x b)
+ (and (not (Math-zerop b))
+ (let ((lnv (math-normalize
+ (list 'calcFunc-ln b))))
+ (math-div 1 (math-mul lnv x))))))
(put 'calcFunc-log\'2 'math-derivative-2
- (function (lambda (x b)
- (let ((lnv (list 'calcFunc-ln b)))
- (math-neg (math-div (list 'calcFunc-log x b)
- (math-mul lnv b)))))))
+ (lambda (x b)
+ (let ((lnv (list 'calcFunc-ln b)))
+ (math-neg (math-div (list 'calcFunc-log x b)
+ (math-mul lnv b))))))
(put 'calcFunc-exp\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-exp u))))
(put 'calcFunc-expm1\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
(put 'calcFunc-sin\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2 (math-normalize
- (list 'calcFunc-cos u)) t))))
+ (lambda (u) (math-to-radians-2 (math-normalize
+ (list 'calcFunc-cos u)) t)))
(put 'calcFunc-cos\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-to-radians-2
- (math-normalize
- (list 'calcFunc-sin u)) t)))))
+ (lambda (u) (math-neg (math-to-radians-2
+ (math-normalize
+ (list 'calcFunc-sin u)) t))))
(put 'calcFunc-tan\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-sec u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-sec u))) t)))
(put 'calcFunc-sec\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-sec u))
- (math-normalize
- (list 'calcFunc-tan u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-sec u))
+ (math-normalize
+ (list 'calcFunc-tan u))) t)))
(put 'calcFunc-csc\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-csc u))
- (math-normalize
- (list 'calcFunc-cot u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-csc u))
+ (math-normalize
+ (list 'calcFunc-cot u))) t))))
(put 'calcFunc-cot\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-csc u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csc u))) t))))
(put 'calcFunc-arcsin\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arccos\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div -1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div -1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arctan\' 'math-derivative-1
- (function (lambda (u) (math-from-radians-2
- (math-div 1 (math-add 1 (math-sqr u))) t))))
+ (lambda (u) (math-from-radians-2
+ (math-div 1 (math-add 1 (math-sqr u))) t)))
(put 'calcFunc-sinh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-cosh u))))
(put 'calcFunc-cosh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-sinh u))))
(put 'calcFunc-tanh\' 'math-derivative-1
- (function (lambda (u) (math-sqr
- (math-normalize
- (list 'calcFunc-sech u))))))
+ (lambda (u) (math-sqr
+ (math-normalize
+ (list 'calcFunc-sech u)))))
(put 'calcFunc-sech\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-sech u))
- (math-normalize (list 'calcFunc-tanh u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-sech u))
+ (math-normalize (list 'calcFunc-tanh u))))))
(put 'calcFunc-csch\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-csch u))
- (math-normalize (list 'calcFunc-coth u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-csch u))
+ (math-normalize (list 'calcFunc-coth u))))))
(put 'calcFunc-coth\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-sqr
- (math-normalize
- (list 'calcFunc-csch u)))))))
+ (lambda (u) (math-neg
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csch u))))))
(put 'calcFunc-arcsinh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) 1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) 1))))))
(put 'calcFunc-arccosh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) -1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) -1))))))
(put 'calcFunc-arctanh\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
+ (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
(put 'calcFunc-bern\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-bern (math-add n -1) x))))
(put 'calcFunc-euler\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-euler (math-add n -1) x))))
(put 'calcFunc-gammag\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x 1))))
+ (lambda (a x) (math-deriv-gamma a x 1)))
(put 'calcFunc-gammaG\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x -1))))
+ (lambda (a x) (math-deriv-gamma a x -1)))
(put 'calcFunc-gammaP\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- 1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ 1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(put 'calcFunc-gammaQ\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- -1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ -1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(defun math-deriv-gamma (a x scale)
(math-mul scale
@@ -537,13 +537,13 @@
(list 'calcFunc-exp (math-neg x)))))
(put 'calcFunc-betaB\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b 1))))
+ (lambda (x a b) (math-deriv-beta x a b 1)))
(put 'calcFunc-betaI\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b
- (math-div
- 1 (list 'calcFunc-beta
- a b))))))
+ (lambda (x a b) (math-deriv-beta x a b
+ (math-div
+ 1 (list 'calcFunc-beta
+ a b)))))
(defun math-deriv-beta (x a b scale)
(math-mul (math-mul (math-pow x (math-add a -1))
@@ -551,101 +551,96 @@
scale))
(put 'calcFunc-erf\' 'math-derivative-1
- (function (lambda (x) (math-div 2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div 2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-erfc\' 'math-derivative-1
- (function (lambda (x) (math-div -2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div -2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-besJ\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
- (math-add v -1)
- z)
- (list 'calcFunc-besJ
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besJ
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-besY\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
- (math-add v -1)
- z)
- (list 'calcFunc-besY
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besY
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-sum 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (cons 'calcFunc-sum
- (cons (math-derivative (nth 1 expr))
- (cdr (cdr expr))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (cons 'calcFunc-sum
+ (cons (math-derivative (nth 1 expr))
+ (cdr (cdr expr)))))))
(put 'calcFunc-prod 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (math-mul expr
- (cons 'calcFunc-sum
- (cons (math-div (math-derivative (nth 1 expr))
- (nth 1 expr))
- (cdr (cdr expr)))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (math-mul expr
+ (cons 'calcFunc-sum
+ (cons (math-div (math-derivative (nth 1 expr))
+ (nth 1 expr))
+ (cdr (cdr expr))))))))
(put 'calcFunc-integ 'math-derivative-n
- (function
- (lambda (expr)
- (if (= (length expr) 3)
- (if (equal (nth 2 expr) math-deriv-var)
- (nth 1 expr)
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr))
- (nth 2 expr))))
- (if (= (length expr) 5)
- (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 3 expr)))
- (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 4 expr))))
- (math-add (math-sub (math-mul upper
- (math-derivative (nth 4 expr)))
- (math-mul lower
- (math-derivative (nth 3 expr))))
- (if (equal (nth 2 expr) math-deriv-var)
- 0
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr)) (nth 2 expr)
- (nth 3 expr) (nth 4 expr)))))))))))
+ (lambda (expr)
+ (if (= (length expr) 3)
+ (if (equal (nth 2 expr) math-deriv-var)
+ (nth 1 expr)
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr))
+ (nth 2 expr))))
+ (if (= (length expr) 5)
+ (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 3 expr)))
+ (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 4 expr))))
+ (math-add (math-sub (math-mul upper
+ (math-derivative (nth 4 expr)))
+ (math-mul lower
+ (math-derivative (nth 3 expr))))
+ (if (equal (nth 2 expr) math-deriv-var)
+ 0
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr)) (nth 2 expr)
+ (nth 3 expr) (nth 4 expr))))))))))
(put 'calcFunc-if 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 4)
- (list 'calcFunc-if (nth 1 expr)
- (math-derivative (nth 2 expr))
- (math-derivative (nth 3 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 4)
+ (list 'calcFunc-if (nth 1 expr)
+ (math-derivative (nth 2 expr))
+ (math-derivative (nth 3 expr))))))
(put 'calcFunc-subscr 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 3)
- (list 'calcFunc-subscr (nth 1 expr)
- (math-derivative (nth 2 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 3)
+ (list 'calcFunc-subscr (nth 1 expr)
+ (math-derivative (nth 2 expr))))))
(defvar math-integ-var '(var X ---))
@@ -1015,11 +1010,10 @@
res '(calcFunc-integsubst)))
(and (memq (length part) '(3 4 5))
(let ((parts (mapcar
- (function
- (lambda (x)
- (math-expr-subst
- x (nth 2 part)
- math-integ-var)))
+ (lambda (x)
+ (math-expr-subst
+ x (nth 2 part)
+ math-integ-var))
(cdr part))))
(math-integrate-by-substitution
expr (car parts) t
@@ -1516,7 +1510,7 @@
var low high)
(nth 2 (nth 2 expr))))
((eq (car-safe expr) 'vec)
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
(cdr expr))))
(t
(let ((state (list calc-angle-mode
@@ -2742,28 +2736,27 @@
math-t1 math-t2 math-t3)
(setq math-t2 (math-polynomial-base
math-solve-lhs
- (function
- (lambda (solve-b)
- (let ((math-solve-b solve-b)
- (math-poly-neg-powers '(1))
- (math-poly-mult-powers nil)
- (math-poly-frac-powers 1)
- (math-poly-exp-base t))
- (and (not (equal math-solve-b math-solve-lhs))
- (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
- (setq math-t3 '(1 0) math-t2 1
- math-t1 (math-is-polynomial math-solve-lhs
- math-solve-b 50))
- (if (and (equal math-poly-neg-powers '(1))
- (memq math-poly-mult-powers '(nil 1))
- (eq math-poly-frac-powers 1)
- sub-rhs)
- (setq math-t1 (cons (math-sub (car math-t1)
math-solve-rhs)
- (cdr math-t1)))
- (math-solve-poly-funny-powers sub-rhs))
- (math-solve-crunch-poly degree)
- (or (math-expr-contains math-solve-b math-solve-var)
- (math-expr-contains (car math-t3)
math-solve-var))))))))
+ (lambda (solve-b)
+ (let ((math-solve-b solve-b)
+ (math-poly-neg-powers '(1))
+ (math-poly-mult-powers nil)
+ (math-poly-frac-powers 1)
+ (math-poly-exp-base t))
+ (and (not (equal math-solve-b math-solve-lhs))
+ (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
+ (setq math-t3 '(1 0) math-t2 1
+ math-t1 (math-is-polynomial math-solve-lhs
+ math-solve-b 50))
+ (if (and (equal math-poly-neg-powers '(1))
+ (memq math-poly-mult-powers '(nil 1))
+ (eq math-poly-frac-powers 1)
+ sub-rhs)
+ (setq math-t1 (cons (math-sub (car math-t1)
math-solve-rhs)
+ (cdr math-t1)))
+ (math-solve-poly-funny-powers sub-rhs))
+ (math-solve-crunch-poly degree)
+ (or (math-expr-contains math-solve-b math-solve-var)
+ (math-expr-contains (car math-t3)
math-solve-var)))))))
(if math-t2
(list (math-pow math-t2 (car math-t3))
(cons 'vec math-t1)
@@ -3326,12 +3319,11 @@
(delq (car v) (copy-sequence var-list))
(let ((math-solve-simplifying nil)
(s (mapcar
- (function
- (lambda (x)
- (cons
- (car x)
- (math-solve-system-subst
- (cdr x)))))
+ (lambda (x)
+ (cons
+ (car x)
+ (math-solve-system-subst
+ (cdr x))))
solns)))
(if elim
s
@@ -3347,35 +3339,33 @@
;; Eliminated all variables, so now put solution into the proper format.
(setq solns (sort solns
- (function
- (lambda (x y)
- (not (memq (car x) (memq (car y) math-solve-vars)))))))
+ (lambda (x y)
+ (not (memq (car x) (memq (car y) math-solve-vars))))))
(if (eq math-solve-full 'all)
(math-transpose
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
- (mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
+ (mapcar (lambda (x) (cons 'vec (cdr x))) solns)
+ (mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
- (mapcar 'car eqn-list)))))))
+ (mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
+ (mapcar #'car eqn-list)))))))
(defun math-solve-system-subst (x) ; uses "res" and "v"
(let ((accum nil)
(res2 math-solve-system-res))
(while x
(setq accum (nconc accum
- (mapcar (function
- (lambda (r)
- (if math-solve-simplifying
- (math-simplify
- (math-expr-subst
- (car x) math-solve-system-vv r))
- (math-expr-subst
- (car x) math-solve-system-vv r))))
+ (mapcar (lambda (r)
+ (if math-solve-simplifying
+ (math-simplify
+ (math-expr-subst
+ (car x) math-solve-system-vv r))
+ (math-expr-subst
+ (car x) math-solve-system-vv r)))
(car res2)))
x (cdr x)
res2 (cdr res2)))
@@ -3471,11 +3461,10 @@
(let ((old-len (length res))
new-len)
(setq res (delq nil
- (mapcar (function
- (lambda (x)
- (and (not (memq (car-safe x)
- '(cplx polar)))
- x)))
+ (mapcar (lambda (x)
+ (and (not (memq (car-safe x)
+ '(cplx polar)))
+ x))
res))
new-len (length res))
(if (< new-len old-len)
@@ -3545,119 +3534,119 @@
(put 'calcFunc-inv 'math-inverse
- (function (lambda (x) (math-div 1 x))))
+ (lambda (x) (math-div 1 x)))
(put 'calcFunc-inv 'math-inverse-sign -1)
(put 'calcFunc-sqrt 'math-inverse
- (function (lambda (x) (math-sqr x))))
+ (lambda (x) (math-sqr x)))
(put 'calcFunc-conj 'math-inverse
- (function (lambda (x) (list 'calcFunc-conj x))))
+ (lambda (x) (list 'calcFunc-conj x)))
(put 'calcFunc-abs 'math-inverse
- (function (lambda (x) (math-solve-get-sign x))))
+ (lambda (x) (math-solve-get-sign x)))
(put 'calcFunc-deg 'math-inverse
- (function (lambda (x) (list 'calcFunc-rad x))))
+ (lambda (x) (list 'calcFunc-rad x)))
(put 'calcFunc-deg 'math-inverse-sign 1)
(put 'calcFunc-rad 'math-inverse
- (function (lambda (x) (list 'calcFunc-deg x))))
+ (lambda (x) (list 'calcFunc-deg x)))
(put 'calcFunc-rad 'math-inverse-sign 1)
(put 'calcFunc-ln 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp x))))
+ (lambda (x) (list 'calcFunc-exp x)))
(put 'calcFunc-ln 'math-inverse-sign 1)
(put 'calcFunc-log10 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp10 x))))
+ (lambda (x) (list 'calcFunc-exp10 x)))
(put 'calcFunc-log10 'math-inverse-sign 1)
(put 'calcFunc-lnp1 'math-inverse
- (function (lambda (x) (list 'calcFunc-expm1 x))))
+ (lambda (x) (list 'calcFunc-expm1 x)))
(put 'calcFunc-lnp1 'math-inverse-sign 1)
(put 'calcFunc-exp 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-exp 'math-inverse-sign 1)
(put 'calcFunc-expm1 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-expm1 'math-inverse-sign 1)
(put 'calcFunc-sin 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsin x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- n))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsin x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ n)))))
(put 'calcFunc-cos 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccos x)))
- (math-solve-get-int
- (math-full-circle t))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccos x)))
+ (math-solve-get-int
+ (math-full-circle t)))))
(put 'calcFunc-tan 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
- (math-solve-get-int
- (math-half-circle t))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
+ (math-solve-get-int
+ (math-half-circle t)))))
(put 'calcFunc-arcsin 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sin x))))
(put 'calcFunc-arccos 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cos x))))
(put 'calcFunc-arctan 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tan x))))
(put 'calcFunc-sinh 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsinh x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- (math-mul
- '(var i var-i)
- n)))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsinh x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ (math-mul
+ '(var i var-i)
+ n))))))
(put 'calcFunc-sinh 'math-inverse-sign 1)
(put 'calcFunc-cosh 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccosh x)))
- (math-mul (math-full-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccosh x)))
+ (math-mul (math-full-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse
- (function (lambda (x) (math-add (math-normalize
- (list 'calcFunc-arctanh x))
- (math-mul (math-half-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-normalize
+ (list 'calcFunc-arctanh x))
+ (math-mul (math-half-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse-sign 1)
(put 'calcFunc-arcsinh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sinh x))))
(put 'calcFunc-arcsinh 'math-inverse-sign 1)
(put 'calcFunc-arccosh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cosh x))))
(put 'calcFunc-arctanh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tanh x))))
(put 'calcFunc-arctanh 'math-inverse-sign 1)
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index f1f6721..fdcde95 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -480,13 +480,13 @@
"Fitting variables"
(format "%s; %s"
(mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
+ (mapcar (lambda (v)
+ (nth 1 v))
defv)
",")
(mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
+ (mapcar (lambda (v)
+ (nth 1 v))
defc)
",")))))
(coefs nil))
@@ -1336,7 +1336,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1352,7 +1352,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1910,8 +1910,8 @@
(while p
(setq vars (delq (assoc (car-safe p) vars) vars)
p (cdr p)))
- (sort (mapcar 'car vars)
- (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
+ (sort (mapcar #'car vars)
+ (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
;; The variables math-all-vars-vars (the vars for math-all-vars) and
;; math-all-vars-found are local to math-all-vars-in, but are used by
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 1f3ae84..e4f6e98 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -464,14 +464,13 @@
(math-compose-vector (cdr (nth 1 a))
(math-vector-to-string sep nil)
(or cprec prec))
- (cons 'horiz (mapcar (function
- (lambda (x)
- (if (eq (car-safe x) 'calcFunc-bstring)
- (prog1
- (math-compose-expr
- x (or bprec cprec prec))
- (setq bprec -123))
- (math-compose-expr x (or cprec prec)))))
+ (cons 'horiz (mapcar (lambda (x)
+ (if (eq (car-safe x) 'calcFunc-bstring)
+ (prog1
+ (math-compose-expr
+ x (or bprec cprec prec))
+ (setq bprec -123))
+ (math-compose-expr x (or cprec prec))))
(cdr (nth 1 a)))))))
((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
(not (eq calc-language 'unform))
@@ -482,47 +481,46 @@
(let* ((base 0)
(v 0)
(prec (or (nth 2 a) prec))
- (c (mapcar (function
- (lambda (x)
- (let ((b nil) (cc nil) a d)
- (if (and (memq (car-safe x) '(calcFunc-cbase
- calcFunc-ctbase
- calcFunc-cbbase))
- (memq (length x) '(1 2)))
- (setq b (car x)
- x (nth 1 x)))
- (if (and (eq (car-safe x) 'calcFunc-crule)
- (memq (length x) '(1 2))
- (or (null (nth 1 x))
- (and (math-vectorp (nth 1 x))
- (= (length (nth 1 x)) 2)
- (math-vector-is-string
- (nth 1 x)))
- (and (natnump (nth 1 x))
- (<= (nth 1 x) 255))))
- (setq cc (list
- 'rule
- (if (math-vectorp (nth 1 x))
- (aref (math-vector-to-string
- (nth 1 x) nil) 0)
- (or (nth 1 x) ?-))))
- (or (and (memq (car-safe x) '(calcFunc-cvspace
- calcFunc-ctspace
- calcFunc-cbspace))
- (memq (length x) '(2 3))
- (eq (nth 1 x) 0))
- (null x)
- (setq cc (math-compose-expr x prec))))
- (setq a (if cc (math-comp-ascent cc) 0)
- d (if cc (math-comp-descent cc) 0))
- (if (eq b 'calcFunc-cbase)
- (setq base (+ v a -1))
- (if (eq b 'calcFunc-ctbase)
- (setq base v)
- (if (eq b 'calcFunc-cbbase)
- (setq base (+ v a d -1)))))
- (setq v (+ v a d))
- cc)))
+ (c (mapcar (lambda (x)
+ (let ((b nil) (cc nil) a d)
+ (if (and (memq (car-safe x) '(calcFunc-cbase
+ calcFunc-ctbase
+ calcFunc-cbbase))
+ (memq (length x) '(1 2)))
+ (setq b (car x)
+ x (nth 1 x)))
+ (if (and (eq (car-safe x) 'calcFunc-crule)
+ (memq (length x) '(1 2))
+ (or (null (nth 1 x))
+ (and (math-vectorp (nth 1 x))
+ (= (length (nth 1 x)) 2)
+ (math-vector-is-string
+ (nth 1 x)))
+ (and (natnump (nth 1 x))
+ (<= (nth 1 x) 255))))
+ (setq cc (list
+ 'rule
+ (if (math-vectorp (nth 1 x))
+ (aref (math-vector-to-string
+ (nth 1 x) nil) 0)
+ (or (nth 1 x) ?-))))
+ (or (and (memq (car-safe x) '(calcFunc-cvspace
+ calcFunc-ctspace
+ calcFunc-cbspace))
+ (memq (length x) '(2 3))
+ (eq (nth 1 x) 0))
+ (null x)
+ (setq cc (math-compose-expr x prec))))
+ (setq a (if cc (math-comp-ascent cc) 0)
+ d (if cc (math-comp-descent cc) 0))
+ (if (eq b 'calcFunc-cbase)
+ (setq base (+ v a -1))
+ (if (eq b 'calcFunc-ctbase)
+ (setq base v)
+ (if (eq b 'calcFunc-cbbase)
+ (setq base (+ v a d -1)))))
+ (setq v (+ v a d))
+ cc))
(cdr (nth 1 a)))))
(setq c (delq nil c))
(if c
@@ -865,16 +863,15 @@
(while (<= (setq col (1+ col)) cols)
(setq res (cons (cons math-comp-just
(cons base
- (mapcar (function
- (lambda (r)
- (list 'horiz
- (math-compose-expr
- (nth col r)
- math-comp-vector-prec)
- (if (= col cols)
- ""
- (concat
- math-comp-comma-spc "
")))))
+ (mapcar (lambda (r)
+ (list 'horiz
+ (math-compose-expr
+ (nth col r)
+ math-comp-vector-prec)
+ (if (= col cols)
+ ""
+ (concat
+ math-comp-comma-spc "
"))))
a)))
res)))
(nreverse res)))
@@ -923,7 +920,7 @@
( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted)
- (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
+ (setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
(cdr a))))
(if (string-match "[\000-\037\177\\\"]" a)
(let ((p 0)
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index d47701d..113f405 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -349,7 +349,11 @@ Optional argument RESERVED is saved for later use."
;;;###autoload
(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver)
"Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
-Only checks one based on which kind of Emacs is being run."
+Only checks one based on which kind of Emacs is being run.
+
+This function is obsolete; do this instead:
+ (when (version<= \"28.1\" emacs-version) ...)"
+ (declare (obsolete nil "28.1"))
(let ((err (inversion-test 'emacs
(cond ((featurep 'sxemacs)
sxemacs-ver)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index bbed1d9..2f05b99 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -464,27 +464,11 @@ Return a bovination list to use."
(define-mode-local-override semantic-dependency-tag-file
emacs-lisp-mode (tag)
"Find the file BUFFER depends on described by TAG."
- (if (fboundp 'find-library-name)
- (condition-case nil
- ;; Try an Emacs 22 fcn. This throws errors.
- (find-library-name (semantic-tag-name tag))
- (error
- (message "semantic: cannot find source file %s"
- (semantic-tag-name tag))))
- ;; No handy function available. (Older Emacsen)
- (let* ((lib (locate-library (semantic-tag-name tag)))
- (name (if lib (file-name-sans-extension lib) nil))
- (nameel (concat name ".el")))
- (cond
- ((and name (file-exists-p nameel)) nameel)
- ((and name (file-exists-p (concat name ".el.gz")))
- ;; This is the linux distro case.
- (concat name ".el.gz"))
- ;; Source file does not exist.
- (name
- (message "semantic: cannot find source file %s" (concat name ".el")))
- (t
- nil)))))
+ (condition-case nil
+ (find-library-name (semantic-tag-name tag))
+ (error
+ (message "semantic: cannot find source file %s"
+ (semantic-tag-name tag)))))
;;; DOC Strings
;;
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index bb2954b..e972015 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -32,7 +32,6 @@
;;
;;; Code:
-(eval-when-compile (require 'font-lock))
(require 'semantic)
(require 'semantic/tag-ls)
(require 'ezimage)
@@ -119,12 +118,10 @@ be used unless font lock is a feature.")
"Apply onto TEXT a color associated with FACE-CLASS.
FACE-CLASS is a tag type found in `semantic-format-face-alist'.
See that variable for details on adding new types."
- (if (featurep 'font-lock)
- (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
- (newtext (concat text)))
- (put-text-property 0 (length text) 'face face newtext)
- newtext)
- text))
+ (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
+ (newtext (concat text)))
+ (put-text-property 0 (length text) 'face face newtext)
+ newtext))
(defun semantic--format-colorize-merge-text (precoloredtext face-class)
"Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 4a129aa..e671160 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -79,15 +79,14 @@
(insert "("))
(t nil))))
-(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated
- "`Semantic-ia-get-completions' is obsolete.
-Use `semantic-analyze-possible-completions' instead.")
+(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
+(make-obsolete 'semantic-ia-get-completions
+ #'semantic-analyze-possible-completions "28.1")
(defun semantic-ia-get-completions-deprecated (context point)
"A function to help transition away from `semantic-ia-get-completions'.
-Return completions based on CONTEXT at POINT.
-You should not use this, nor the aliased version.
-Use `semantic-analyze-possible-completions' instead."
+Return completions based on CONTEXT at POINT."
+ (declare (obsolete semantic-analyze-possible-completions "28.1"))
(semantic-analyze-possible-completions context))
;;;###autoload
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 89fc917..a565d87 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -46,11 +46,7 @@
(defun semantic-string-lessp-ci (s1 s2)
"Case insensitive version of `string-lessp'.
Argument S1 and S2 are the strings to compare."
- ;; Use downcase instead of upcase because an average name
- ;; has more lower case characters.
- (if (fboundp 'compare-strings)
- (eq (compare-strings s1 0 nil s2 0 nil t) -1)
- (string-lessp (downcase s1) (downcase s2))))
+ (eq (compare-strings s1 0 nil s2 0 nil t) -1))
(defun semantic-sort-tag-type (tag)
"Return a type string for TAG guaranteed to be a string."
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index d8de8ea..29e88cd 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -167,24 +167,10 @@ This shell should support pipe redirect syntax."
(with-current-buffer b
(erase-buffer)
(setq default-directory rootdir)
-
- (if (not (fboundp 'grep-compute-defaults))
-
- ;; find . -type f -print0 | xargs -0 -e grep -nH -e
- ;; Note : I removed -e as it is not posix, nor necessary it seems.
-
- (let ((cmd (concat "find " (file-local-name rootdir)
- " -type f " filepattern " -print0 "
- "| xargs -0 grep -H " grepflags "-e " greppat)))
- ;;(message "Old command: %s" cmd)
- (process-file semantic-symref-grep-shell nil b nil
- shell-command-switch cmd)
- )
- (let ((cmd (semantic-symref-grep-use-template
- (file-local-name rootdir) filepattern grepflags greppat)))
- (process-file semantic-symref-grep-shell nil b nil
- shell-command-switch cmd))
- ))
+ (let ((cmd (semantic-symref-grep-use-template
+ (file-local-name rootdir) filepattern grepflags greppat)))
+ (process-file semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd)))
(setq ans (semantic-symref-parse-tool-output tool b))
;; Return the answer
ans))
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index e677264..3dadf34 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -53,6 +53,11 @@
(declare-function semantic-clear-toplevel-cache "semantic")
(declare-function semantic-tag-similar-p "semantic/tag-ls")
+(define-obsolete-variable-alias 'semantic-token-version
+ 'semantic-tag-version "28.1")
+(define-obsolete-variable-alias 'semantic-token-incompatible-version
+ 'semantic-tag-incompatible-version "28.1")
+
(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
@@ -1321,12 +1326,6 @@ This function is overridable with the symbol
`insert-foreign-tag'."
"Insert foreign tags into log-edit mode."
(insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
-;;; Compatibility
-;;
-(defconst semantic-token-version
- semantic-tag-version)
-(defconst semantic-token-incompatible-version
- semantic-tag-incompatible-version)
(provide 'semantic/tag)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 0eb4dbf..01b8049 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -205,7 +205,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(setq where (get symbol 'custom-where))
(when where
(if (or (custom-variable-p symbol)
- (custom-facep symbol))
+ (facep symbol))
;; This means it's a variable or a face.
(progn
(if (assoc version version-alist)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index d1077d3..eceba8f 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1295,10 +1295,11 @@ that were added or redefined since that version."
(push (list symbol 'custom-group) found))
(if (custom-variable-p symbol)
(push (list symbol 'custom-variable) found))
- (if (custom-facep symbol)
+ (if (facep symbol)
(push (list symbol 'custom-face) found)))))))
(if found
- (custom-buffer-create (custom-sort-items found t 'first)
+ (custom-buffer-create (custom--filter-obsolete-variables
+ (custom-sort-items found t 'first))
"*Customize Changed Options*")
(user-error "No user option defaults have been changed since Emacs %s"
since-version))))
@@ -1405,7 +1406,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'customized-face)
(get symbol 'customized-face-comment))
- (custom-facep symbol)
+ (facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'customized-value)
(get symbol 'customized-variable-comment))
@@ -1452,7 +1453,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'saved-face)
(get symbol 'saved-face-comment))
- (custom-facep symbol)
+ (facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'saved-value)
(get symbol 'saved-variable-comment))
@@ -1490,7 +1491,7 @@ If TYPE is `groups', include only groups."
(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
(if (memq type '(nil faces))
- (if (custom-facep symbol)
+ (if (facep symbol)
(push (list symbol 'custom-face) found)))
(if (memq type '(nil options))
(if (and (boundp symbol)
@@ -1504,7 +1505,8 @@ If TYPE is `groups', include only groups."
(symbol-name type))
pattern))
(custom-buffer-create
- (custom-sort-items found t custom-buffer-order-groups)
+ (custom--filter-obsolete-variables
+ (custom-sort-items found t custom-buffer-order-groups))
"*Customize Apropos*")))
;;;###autoload
@@ -4232,6 +4234,13 @@ and so forth. The remaining group tags are shown with
`custom-group-tag'."
(insert "--------")))
(widget-default-create widget))
+(defun custom--filter-obsolete-variables (items)
+ "Filter obsolete variables from ITEMS."
+ (seq-remove (lambda (item)
+ (and (eq (nth 1 item) 'custom-variable)
+ (get (nth 0 item) 'byte-obsolete-variable)))
+ items))
+
(defun custom-group-members (symbol groups-only)
"Return SYMBOL's custom group members.
If GROUPS-ONLY is non-nil, return only those members that are groups."
@@ -4437,12 +4446,13 @@ This works for both graphical and text displays."
?\s))
;; Members.
(message "Creating group...")
- (let* ((members (custom-sort-items
- members
- ;; Never sort the top-level custom group.
- (unless (eq symbol 'emacs)
- custom-buffer-sort-alphabetically)
- custom-buffer-order-groups))
+ (let* ((members (custom--filter-obsolete-variables
+ (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ custom-buffer-sort-alphabetically)
+ custom-buffer-order-groups)))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
(have-subtitle (and (not (eq symbol 'emacs))
@@ -4888,7 +4898,7 @@ This function does not save the buffer."
(let ((spec (car-safe (get symbol 'theme-face)))
(value (get symbol 'saved-face))
(now (not (or (get symbol 'face-defface-spec)
- (and (not (custom-facep symbol))
+ (and (not (facep symbol))
(not (get symbol 'force-face))))))
(comment (get symbol 'saved-face-comment)))
(when (or (and spec (eq (nth 0 spec) 'user))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index cc766aa..199a76e 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -27,8 +27,6 @@
;;; Code:
-(defalias 'custom-facep 'facep)
-
;;; Declaring a face.
(defun custom-declare-face (face spec doc &rest args)
@@ -394,6 +392,8 @@ Each of the arguments ARGS has this form:
This means reset FACE to its value in FROM-THEME."
(apply 'custom-theme-reset-faces 'user args))
+(define-obsolete-function-alias 'custom-facep #'facep "28.1")
+
;;; The End.
(provide 'cus-face)
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 1d9b472..44cf5aa 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -535,32 +535,31 @@ doubt, use whitespace."
(setq bind-len (1+ text)))
(t
(setq desc (mapconcat
- (function
- (lambda (ch)
- (cond
- ((integerp ch)
- (concat
- (cl-loop for pf across "ACHMsS"
- for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
- ?\M-\^@ ?\s-\^@ ?\S-\^@)
- when (/= (logand ch bit) 0)
- concat (format "%c-" pf))
- (let ((ch2 (logand ch (1- (ash 1 18)))))
- (cond ((<= ch2 32)
- (pcase ch2
- (0 "NUL") (9 "TAB") (10 "LFD")
- (13 "RET") (27 "ESC") (32 "SPC")
- (_
- (format "C-%c"
- (+ (if (<= ch2 26) 96 64)
- ch2)))))
- ((= ch2 127) "DEL")
- ((<= ch2 maxkey) (char-to-string ch2))
- (t (format "\\%o" ch2))))))
- ((symbolp ch)
- (format "<%s>" ch))
- (t
- (error "Unrecognized item in macro: %s" ch)))))
+ (lambda (ch)
+ (cond
+ ((integerp ch)
+ (concat
+ (cl-loop for pf across "ACHMsS"
+ for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
+ ?\M-\^@ ?\s-\^@
?\S-\^@)
+ when (/= (logand ch bit) 0)
+ concat (format "%c-" pf))
+ (let ((ch2 (logand ch (1- (ash 1 18)))))
+ (cond ((<= ch2 32)
+ (pcase ch2
+ (0 "NUL") (9 "TAB") (10 "LFD")
+ (13 "RET") (27 "ESC") (32 "SPC")
+ (_
+ (format "C-%c"
+ (+ (if (<= ch2 26) 96 64)
+ ch2)))))
+ ((= ch2 127) "DEL")
+ ((<= ch2 maxkey) (char-to-string ch2))
+ (t (format "\\%o" ch2))))))
+ ((symbolp ch)
+ (format "<%s>" ch))
+ (t
+ (error "Unrecognized item in macro: %s" ch))))
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index fb35187..e16ce9f 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2375,28 +2375,26 @@ The assignment starts at position INDEX."
(defun ad-insert-argument-access-forms (definition arglist)
"Expands arg-access text macros in DEFINITION according to ARGLIST."
(ad-substitute-tree
- (function
- (lambda (form)
- (or (eq form 'ad-arg-bindings)
- (and (memq (car-safe form)
- '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
- (integerp (car-safe (cdr form)))))))
- (function
- (lambda (form)
- (if (eq form 'ad-arg-bindings)
- (ad-retrieve-args-form arglist)
- (let ((accessor (car form))
- (index (car (cdr form)))
- (val (car (cdr (ad-insert-argument-access-forms
- (cdr form) arglist)))))
- (cond ((eq accessor 'ad-get-arg)
- (ad-get-argument arglist index))
- ((eq accessor 'ad-set-arg)
- (ad-set-argument arglist index val))
- ((eq accessor 'ad-get-args)
- (ad-get-arguments arglist index))
- ((eq accessor 'ad-set-args)
- (ad-set-arguments arglist index val)))))))
+ (lambda (form)
+ (or (eq form 'ad-arg-bindings)
+ (and (memq (car-safe form)
+ '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
+ (integerp (car-safe (cdr form))))))
+ (lambda (form)
+ (if (eq form 'ad-arg-bindings)
+ (ad-retrieve-args-form arglist)
+ (let ((accessor (car form))
+ (index (car (cdr form)))
+ (val (car (cdr (ad-insert-argument-access-forms
+ (cdr form) arglist)))))
+ (cond ((eq accessor 'ad-get-arg)
+ (ad-get-argument arglist index))
+ ((eq accessor 'ad-set-arg)
+ (ad-set-argument arglist index val))
+ ((eq accessor 'ad-get-args)
+ (ad-get-arguments arglist index))
+ ((eq accessor 'ad-set-args)
+ (ad-set-arguments arglist index val))))))
definition))
;; @@@ Mapping argument lists:
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 2fa5a87..8cf1f54 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -43,7 +43,7 @@
;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
"Time execution of FORMS.
-If REPETITIONS is supplied as a number, run forms that many times,
+If REPETITIONS is supplied as a number, run FORMS that many times,
accounting for the overhead of the resulting loop. Otherwise run
FORMS once.
Return a list of the total elapsed time for execution, the number of
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 6d2bff1..532f3d1 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2642,7 +2642,8 @@ list that represents a doc string reference.
;; and similar macros cleaner.
(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
(defun byte-compile-file-form-eval (form)
- (if (eq (car-safe (nth 1 form)) 'quote)
+ (if (and (eq (car-safe (nth 1 form)) 'quote)
+ (equal (nth 2 form) lexical-binding))
(nth 1 (nth 1 form))
(byte-compile-keep-pending form)))
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index d3159a3..a55d78d 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -209,10 +209,10 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
- (apply 'cl-map nil
- (function (lambda (&rest cl-x)
- (let ((cl-res (apply cl-pred cl-x)))
- (if cl-res (throw 'cl-some cl-res)))))
+ (apply #'cl-map nil
+ (lambda (&rest cl-x)
+ (let ((cl-res (apply cl-pred cl-x)))
+ (if cl-res (throw 'cl-some cl-res))))
cl-seq cl-rest) nil)
(let ((cl-x nil))
(while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
@@ -224,9 +224,9 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-every
- (apply 'cl-map nil
- (function (lambda (&rest cl-x)
- (or (apply cl-pred cl-x) (throw 'cl-every nil))))
+ (apply #'cl-map nil
+ (lambda (&rest cl-x)
+ (or (apply cl-pred cl-x) (throw 'cl-every nil)))
cl-seq cl-rest) t)
(while (and cl-seq (funcall cl-pred (car cl-seq)))
(setq cl-seq (cdr cl-seq)))
@@ -249,14 +249,13 @@ non-nil value.
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
- (function
- (lambda (cl-key cl-bind)
- (aset cl-base (1- (length cl-base)) cl-key)
- (if (keymapp cl-bind)
- (cl--map-keymap-recursively
- cl-func-rec cl-bind
- (vconcat cl-base (list 0)))
- (funcall cl-func-rec cl-base cl-bind))))
+ (lambda (cl-key cl-bind)
+ (aset cl-base (1- (length cl-base)) cl-key)
+ (if (keymapp cl-bind)
+ (cl--map-keymap-recursively
+ cl-func-rec cl-bind
+ (vconcat cl-base (list 0)))
+ (funcall cl-func-rec cl-base cl-bind)))
cl-map))
;;;###autoload
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6f98e0f..f4b22ff 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -819,16 +819,15 @@ final clause, and matches if no other keys match.
(cons
'cond
(mapcar
- (function
- (lambda (c)
- (cons (cond ((eq (car c) 'otherwise) t)
- ((eq (car c) 'cl--ecase-error-flag)
- `(error "cl-etypecase failed: %s, %s"
- ,temp ',(reverse type-list)))
- (t
- (push (car c) type-list)
- `(cl-typep ,temp ',(car c))))
- (or (cdr c) '(nil)))))
+ (lambda (c)
+ (cons (cond ((eq (car c) 'otherwise) t)
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-etypecase failed: %s, %s"
+ ,temp ',(reverse type-list)))
+ (t
+ (push (car c) type-list)
+ `(cl-typep ,temp ',(car c))))
+ (or (cdr c) '(nil))))
clauses)))))
;;;###autoload
@@ -2793,7 +2792,7 @@ Supported keywords for slots are:
(unless (cl--struct-name-p name)
(signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
(setq descs (cons '(cl-tag-slot)
- (mapcar (function (lambda (x) (if (consp x) x (list x))))
+ (mapcar (lambda (x) (if (consp x) x (list x)))
descs)))
(while opts
(let ((opt (if (consp (car opts)) (caar opts) (car opts)))
@@ -2820,9 +2819,8 @@ Supported keywords for slots are:
;; we include EIEIO classes rather than cl-structs!
(when include-name (error "Can't :include more than once"))
(setq include-name (car args))
- (setq include-descs (mapcar (function
- (lambda (x)
- (if (consp x) x (list x))))
+ (setq include-descs (mapcar (lambda (x)
+ (if (consp x) x (list x)))
(cdr args))))
((eq opt :print-function)
(setq print-func (car args)))
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index d34d501..8cfdd14 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -69,10 +69,9 @@
(list 'or (list 'memq '(car cl-keys-temp)
(list 'quote
(mapcar
- (function
- (lambda (x)
- (if (consp x)
- (car x) x)))
+ (lambda (x)
+ (if (consp x)
+ (car x) x))
(append kwords
other-keys))))
'(car (cdr (memq (quote :allow-other-keys)
@@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of
SEQ if possible.
(cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
- (sort cl-seq (function (lambda (cl-x cl-y)
- (funcall cl-pred (funcall cl-key cl-x)
- (funcall cl-key cl-y)))))))))
+ (sort cl-seq (lambda (cl-x cl-y)
+ (funcall cl-pred (funcall cl-key cl-x)
+ (funcall cl-key cl-y))))))))
;;;###autoload
(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 73dabef..b0198db 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -514,6 +514,7 @@ completely and menu filter functions can be expected to
work.
If BEFORE is non-nil, add before the item named BEFORE.
If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
This is a compatibility function; use `easy-menu-add-item'."
+ (declare (obsolete easy-menu-add-item "28.1"))
(easy-menu-add-item (or in-menu (current-global-map))
(cons "menu-bar" menu-path)
submenu before))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e310313..f242e92 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'."
(defun edebug-sort-alist (alist function)
;; Return the ALIST sorted with comparison function FUNCTION.
;; This uses 'sort so the sorting is destructive.
- (sort alist (function
- (lambda (e1 e2)
- (funcall function (car e1) (car e2))))))
+ (sort alist (lambda (e1 e2)
+ (funcall function (car e1) (car e2)))))
;; Not used.
'(defmacro edebug-save-restriction (&rest body)
@@ -407,14 +406,13 @@ Return the result of the last expression in BODY."
(if (listp window-info)
(mapcar (lambda (one-window-info)
(if one-window-info
- (apply (function
- (lambda (window buffer point start hscroll)
- (if (edebug-window-live-p window)
- (progn
- (set-window-buffer window buffer)
- (set-window-point window point)
- (set-window-start window start)
- (set-window-hscroll window hscroll)))))
+ (apply (lambda (window buffer point start hscroll)
+ (if (edebug-window-live-p window)
+ (progn
+ (set-window-buffer window buffer)
+ (set-window-point window point)
+ (set-window-start window start)
+ (set-window-hscroll window hscroll))))
one-window-info)))
window-info)
(set-window-configuration window-info)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 3559012..1249001 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -784,9 +784,17 @@ This command assumes point is not in a string or comment."
(interactive "P")
(insert-pair arg ?\( ?\)))
+(defcustom delete-pair-blink-delay blink-matching-delay
+ "Time in seconds to delay after showing a paired character to delete.
+It's used by the command `delete-pair'. The value 0 disables blinking."
+ :type 'number
+ :group 'lisp
+ :version "28.1")
+
(defun delete-pair (&optional arg)
"Delete a pair of characters enclosing ARG sexps that follow point.
-A negative ARG deletes a pair around the preceding ARG sexps instead."
+A negative ARG deletes a pair around the preceding ARG sexps instead.
+The option `delete-pair-blink-delay' can disable blinking."
(interactive "P")
(if arg
(setq arg (prefix-numeric-value arg))
@@ -802,6 +810,9 @@ A negative ARG deletes a pair around the preceding ARG
sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not after matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
(delete-char 1)))
(delete-char -1))
(save-excursion
@@ -814,6 +825,9 @@ A negative ARG deletes a pair around the preceding ARG
sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not before matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
(delete-char -1)))
(delete-char 1))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 9264a81..0ee2e58 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2129,8 +2129,7 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
- (ignore-errors
- (if (version-to-list str) str))))
+ (if (version-to-list str) str)))
(declare-function lm-homepage "lisp-mnt" (&optional file))
@@ -2731,7 +2730,9 @@ either a full name or nil, and EMAIL is a valid email
address."
(define-key map "(" #'package-menu-toggle-hiding)
(define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ d") 'package-menu-filter-by-description)
(define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description)
(define-key map (kbd "/ n") 'package-menu-filter-by-name)
(define-key map (kbd "/ s") 'package-menu-filter-by-status)
(define-key map (kbd "/ v") 'package-menu-filter-by-version)
@@ -2763,8 +2764,11 @@ either a full name or nil, and EMAIL is a valid email
address."
"--"
("Filter Packages"
["Filter by Archive" package-menu-filter-by-archive :help "Filter
packages by archive"]
+ ["Filter by Description" package-menu-filter-by-description :help "Filter
packages by description"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter
packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by
name"]
+ ["Filter by Name or Description"
package-menu-filter-by-name-or-description
+ :help "Filter packages by name or description"]
["Filter by Status" package-menu-filter-by-status :help "Filter packages
by status"]
["Filter by Version" package-menu-filter-by-version :help "Filter
packages by version"]
["Filter Marked" package-menu-filter-marked :help "Filter packages marked
for upgrade"]
@@ -3792,6 +3796,23 @@ packages."
(string-join archive ",")
archive)))))
+(defun package-menu-filter-by-description (description)
+ "Filter the \"*Packages*\" buffer by DESCRIPTION regexp.
+Display only packages with a description that matches regexp
+DESCRIPTION.
+
+When called interactively, prompt for DESCRIPTION.
+
+If DESCRIPTION is nil or the empty string, show all packages."
+ (interactive (list (read-regexp "Filter by description (regexp)")))
+ (package--ensure-package-menu-mode)
+ (if (or (not description) (string-empty-p description))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match description
+ (package-desc-summary pkg-desc)))
+ (format "desc:%s" description))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
Display only packages with specified KEYWORD.
@@ -3817,6 +3838,27 @@ packages."
(define-obsolete-function-alias
'package-menu-filter #'package-menu-filter-by-keyword "27.1")
+(defun package-menu-filter-by-name-or-description (name-or-description)
+ "Filter the \"*Packages*\" buffer by NAME-OR-DESCRIPTION regexp.
+Display only packages with a name-or-description that matches regexp
+NAME-OR-DESCRIPTION.
+
+When called interactively, prompt for NAME-OR-DESCRIPTION.
+
+If NAME-OR-DESCRIPTION is nil or the empty string, show all
+packages."
+ (interactive (list (read-regexp "Filter by name or description (regexp)")))
+ (package--ensure-package-menu-mode)
+ (if (or (not name-or-description) (string-empty-p name-or-description))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (or (string-match name-or-description
+ (package-desc-summary pkg-desc))
+ (string-match name-or-description
+ (symbol-name
+ (package-desc-name pkg-desc)))))
+ (format "name-or-desc:%s" name-or-description))))
+
(defun package-menu-filter-by-name (name)
"Filter the \"*Packages*\" buffer by NAME regexp.
Display only packages with name that matches regexp NAME.
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index eb2ee94..458f803 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -94,27 +94,25 @@ after OUT-BUFFER-NAME."
;; This function either decides not to display it at all
;; or displays it in the usual way.
(temp-buffer-show-function
- (function
- (lambda (buf)
- (with-current-buffer buf
- (goto-char (point-min))
- (end-of-line 1)
- (if (or (< (1+ (point)) (point-max))
- (>= (- (point) (point-min)) (frame-width)))
- (let ((temp-buffer-show-function old-show-function)
- (old-selected (selected-window))
- (window (display-buffer buf)))
- (goto-char (point-min)) ; expected by some hooks ...
- (make-frame-visible (window-frame window))
- (unwind-protect
- (progn
- (select-window window)
- (run-hooks 'temp-buffer-show-hook))
- (when (window-live-p old-selected)
- (select-window old-selected))
- (message "See buffer %s." out-buffer-name)))
- (message "%s" (buffer-substring (point-min) (point)))
- ))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (end-of-line 1)
+ (if (or (< (1+ (point)) (point-max))
+ (>= (- (point) (point-min)) (frame-width)))
+ (let ((temp-buffer-show-function old-show-function)
+ (old-selected (selected-window))
+ (window (display-buffer buf)))
+ (goto-char (point-min)) ; expected by some hooks ...
+ (make-frame-visible (window-frame window))
+ (unwind-protect
+ (progn
+ (select-window window)
+ (run-hooks 'temp-buffer-show-hook))
+ (when (window-live-p old-selected)
+ (select-window old-selected))
+ (message "See buffer %s." out-buffer-name)))
+ (message "%s" (buffer-substring (point-min) (point))))))))
(with-output-to-temp-buffer out-buffer-name
(pp expression)
(with-current-buffer standard-output
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 11b28b7..2e6e2b7 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -163,18 +163,15 @@ useful information:
;; let's find the special tags and remove them from the working
;; frame. note that only the last special tag is used.
(mapc
- (function
- (lambda (entry)
- (let ((pred (car entry))
- (func (car (cdr entry))))
- (cond
- ((eq pred 'begin) (setq begin-tag func))
- ((eq pred 'end) (setq end-tag func))
- ((eq pred 'every) (setq every-tag func))
- (t
- (setq working-frame (append working-frame (list entry))))
- ) ; end-cond
- )))
+ (lambda (entry)
+ (let ((pred (car entry))
+ (func (car (cdr entry))))
+ (cond
+ ((eq pred 'begin) (setq begin-tag func))
+ ((eq pred 'end) (setq end-tag func))
+ ((eq pred 'every) (setq every-tag func))
+ (t
+ (setq working-frame (append working-frame (list entry)))))))
frame) ; end-mapcar
;; execute the begin entry
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index e70b446..b29ad77 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -2161,8 +2161,7 @@ Argument KEY is the name of a key. It can be a standard
key or a function key.
Argument BINDING is the Emacs function to be bound to <KEY>."
(define-key edt-user-global-map key binding))
-;; For backward compatibility to existing edt-user.el files.
-(fset 'edt-bind-standard-key (symbol-function 'edt-bind-key))
+(define-obsolete-function-alias 'edt-bind-standard-key #'edt-bind-key "28.1")
(defun edt-bind-gold-key (key gold-binding)
"Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator.
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 83e45e1..9da493d 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -249,15 +249,7 @@ Otherwise return the normal value."
(goto-char cur-pos)
result))
-;; Emacs used to count each multibyte character as several positions in the
buffer,
-;; so we had to use Emacs's chars-in-region to count characters. Since 20.3,
-;; Emacs counts multibyte characters as 1 position. XEmacs has always been
-;; counting each char as just one pos. So, now we can simply subtract beg from
-;; end to determine the number of characters in a region.
(defun viper-chars-in-region (beg end &optional preserve-sign)
- ;;(let ((count (abs (if (fboundp 'chars-in-region)
- ;; (chars-in-region beg end)
- ;; (- end beg)))))
(let ((count (abs (- end beg))))
(if (and (< end beg) preserve-sign)
(- count)
diff --git a/lisp/epa.el b/lisp/epa.el
index 25e055c..d6c7946 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -24,7 +24,6 @@
;;; Dependencies
(require 'epg)
-(require 'font-lock)
(eval-when-compile (require 'subr-x))
(require 'derived)
@@ -1071,9 +1070,7 @@ If no one is selected, default secret key is used. "
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+ 'rear-nonsticky t)))))
(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
@@ -1148,9 +1145,7 @@ If no one is selected, symmetric encryption will be
performed. ")
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+ 'rear-nonsticky t)))))
;;;; Key Management
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index de0a16e..7eddb5f 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -414,8 +414,7 @@ You can save every individual message by putting this
function on
(or buffer (setq buffer (current-buffer)))
(when (erc-logging-enabled buffer)
(let ((file (erc-current-logfile buffer))
- (coding-system erc-log-file-coding-system)
- (inhibit-clash-detection t)) ; needed for XEmacs
+ (coding-system erc-log-file-coding-system))
(save-excursion
(with-current-buffer buffer
(save-restriction
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e35ae0c..94ea0de 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -58,7 +58,6 @@
(load "erc-loaddefs" nil t)
(require 'cl-lib)
-(require 'font-lock)
(require 'format-spec)
(require 'pp)
(require 'thingatpt)
@@ -4015,8 +4014,7 @@ If FACE is non-nil, it will be used to propertize the
prompt. If it is nil,
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
- 'start-open t ; XEmacs
- 'rear-nonsticky t ; Emacs
+ 'rear-nonsticky t
'erc-prompt t
'field t
'front-sticky t
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 6cfc89c..e54eab5 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -90,11 +90,10 @@ or `eshell-printn' for display."
(car args))
(t
(mapcar
- (function
- (lambda (arg)
- (if (stringp arg)
- (set-text-properties 0 (length arg) nil arg))
- arg))
+ (lambda (arg)
+ (if (stringp arg)
+ (set-text-properties 0 (length arg) nil arg))
+ arg)
args)))))
(if output-newline
(cond
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 8a444c9..53a0cda 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -210,9 +210,8 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (eshell-complete-commands-list))))
+ (lambda ()
+ (pcomplete-here (eshell-complete-commands-list)))
(eshell-cmpl--custom-variable-docstring
'pcomplete-command-completion-function)
:type (get 'pcomplete-command-completion-function 'custom-type)
:group 'eshell-cmpl)
@@ -224,12 +223,11 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here
- (pcomplete-dirs-or-entries
- (cdr (assoc (funcall eshell-cmpl-command-name-function)
- eshell-command-completions-alist)))))))
+ (lambda ()
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries
+ (cdr (assoc (funcall eshell-cmpl-command-name-function)
+ eshell-command-completions-alist))))))
(eshell-cmpl--custom-variable-docstring
'pcomplete-default-completion-function)
:type (get 'pcomplete-default-completion-function 'custom-type)
:group 'eshell-cmpl)
@@ -308,10 +306,9 @@ to writing a completion function."
;; load-hooks for any other extension modules have been run, which
;; is true at the time `eshell-mode-hook' is run
(add-hook 'eshell-mode-hook
- (function
- (lambda ()
- (set (make-local-variable 'comint-file-name-quote-list)
- eshell-special-chars-outside-quoting)))
+ (lambda ()
+ (set (make-local-variable 'comint-file-name-quote-list)
+ eshell-special-chars-outside-quoting))
nil t)
(add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
(add-hook 'completion-at-point-functions
@@ -391,19 +388,18 @@ to writing a completion function."
(nconc args (list ""))
(nconc posns (list (point))))
(cons (mapcar
- (function
- (lambda (arg)
- (let ((val
- (if (listp arg)
- (let ((result
- (eshell-do-eval
- (list 'eshell-commands arg) t)))
- (cl-assert (eq (car result) 'quote))
- (cadr result))
- arg)))
- (if (numberp val)
- (setq val (number-to-string val)))
- (or val ""))))
+ (lambda (arg)
+ (let ((val
+ (if (listp arg)
+ (let ((result
+ (eshell-do-eval
+ (list 'eshell-commands arg) t)))
+ (cl-assert (eq (car result) 'quote))
+ (cadr result))
+ arg)))
+ (if (numberp val)
+ (setq val (number-to-string val)))
+ (or val "")))
args)
posns)))
@@ -454,9 +450,8 @@ to writing a completion function."
(eshell-alias-completions filename))
(eshell-winnow-list
(mapcar
- (function
- (lambda (name)
- (substring name 7)))
+ (lambda (name)
+ (substring name 7))
(all-completions (concat "eshell/" filename)
obarray #'functionp))
nil '(eshell-find-alias-function))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 51df6fa..b4ed379 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -289,9 +289,8 @@ Thus, this does not include the current directory.")
(eshell-read-user-names)
(pcomplete-uniquify-list
(mapcar
- (function
- (lambda (user)
- (file-name-as-directory (cdr user))))
+ (lambda (user)
+ (file-name-as-directory (cdr user)))
eshell-user-names)))))))
(defun eshell/pwd (&rest _args)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index bdc21c9..c27e450 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -79,9 +79,8 @@
(defcustom eshell-hist-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
+ (lambda ()
+ (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
"A hook that gets run when `eshell-hist' is unloaded."
:type 'hook)
@@ -250,16 +249,14 @@ Returns nil if INPUT is prepended by blank space,
otherwise non-nil."
(set (make-local-variable 'search-invisible) t)
(set (make-local-variable 'search-exit-option) t)
(add-hook 'isearch-mode-hook
- (function
- (lambda ()
- (if (>= (point) eshell-last-output-end)
- (setq overriding-terminal-local-map
- eshell-isearch-map))))
+ (lambda ()
+ (if (>= (point) eshell-last-output-end)
+ (setq overriding-terminal-local-map
+ eshell-isearch-map)))
nil t)
(add-hook 'isearch-mode-end-hook
- (function
- (lambda ()
- (setq overriding-terminal-local-map nil)))
+ (lambda ()
+ (setq overriding-terminal-local-map nil))
nil t))
(eshell-hist-mode))
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index c1a022e..6b306f7 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -270,8 +270,7 @@ instead."
eshell-current-subjob-p
font-lock-mode)
;; use the fancy highlighting in `eshell-ls' rather than font-lock
- (when (and eshell-ls-use-colors
- (featurep 'font-lock))
+ (when eshell-ls-use-colors
(font-lock-mode -1)
(setq font-lock-defaults nil)
(if (boundp 'font-lock-buffers)
@@ -631,38 +630,37 @@ In Eshell's implementation of ls, ENTRIES is always
reversed."
(if (eq sort-method 'unsorted)
(nreverse entries)
(sort entries
- (function
- (lambda (l r)
- (let ((result
- (cond
- ((eq sort-method 'by-atime)
- (eshell-ls-compare-entries l r 4 'time-less-p))
- ((eq sort-method 'by-mtime)
- (eshell-ls-compare-entries l r 5 'time-less-p))
- ((eq sort-method 'by-ctime)
- (eshell-ls-compare-entries l r 6 'time-less-p))
- ((eq sort-method 'by-size)
- (eshell-ls-compare-entries l r 7 '<))
- ((eq sort-method 'by-extension)
- (let ((lx (file-name-extension
- (directory-file-name (car l))))
- (rx (file-name-extension
- (directory-file-name (car r)))))
- (cond
- ((or (and (not lx) (not rx))
- (equal lx rx))
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r))))
- ((not lx) t)
- ((not rx) nil)
- (t
- (string-lessp lx rx)))))
- (t
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r)))))))
- (if reverse-list
- (not result)
- result)))))))
+ (lambda (l r)
+ (let ((result
+ (cond
+ ((eq sort-method 'by-atime)
+ (eshell-ls-compare-entries l r 4 'time-less-p))
+ ((eq sort-method 'by-mtime)
+ (eshell-ls-compare-entries l r 5 'time-less-p))
+ ((eq sort-method 'by-ctime)
+ (eshell-ls-compare-entries l r 6 'time-less-p))
+ ((eq sort-method 'by-size)
+ (eshell-ls-compare-entries l r 7 '<))
+ ((eq sort-method 'by-extension)
+ (let ((lx (file-name-extension
+ (directory-file-name (car l))))
+ (rx (file-name-extension
+ (directory-file-name (car r)))))
+ (cond
+ ((or (and (not lx) (not rx))
+ (equal lx rx))
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r))))
+ ((not lx) t)
+ ((not rx) nil)
+ (t
+ (string-lessp lx rx)))))
+ (t
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r)))))))
+ (if reverse-list
+ (not result)
+ result))))))
(defun eshell-ls-files (files &optional size-width copy-fileinfo)
"Output a list of FILES.
@@ -799,9 +797,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
;; must account for the added space...
(max-width (+ (window-width) 2))
@@ -846,9 +843,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
(max-width (+ (window-width) 2))
col-widths
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 59139da..7b95039 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -116,10 +116,9 @@ The format of each entry is
(defcustom eshell-modifier-alist
'((?E . #'(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str)))))
+ (lambda (str)
+ (eshell-stringify
+ (car (eshell-parse-argument str))))
lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
@@ -240,16 +239,14 @@ EXAMPLES:
(defun eshell-display-predicate-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-predicate-help-string)))))
+ (lambda ()
+ (insert eshell-predicate-help-string))))
(defun eshell-display-modifier-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-modifier-help-string)))))
+ (lambda ()
+ (insert eshell-modifier-help-string))))
(define-minor-mode eshell-pred-mode
"Minor mode for the eshell-pred module.
@@ -544,20 +541,20 @@ that `ls -l' will show in the first column of its
display."
(if repeat
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match ,match str i))
- (setq str (replace-match ,replace t nil str))))
- str)) lst))
+ (lambda (str)
+ (let ((i 0))
+ (while (setq i (string-match ,match str i))
+ (setq str (replace-match ,replace t nil str))))
+ str)
+ lst))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (if (string-match ,match str)
- (setq str (replace-match ,replace t nil str))
- (error (concat str ": substitution failed")))
- str)) lst)))))
+ (lambda (str)
+ (if (string-match ,match str)
+ (setq str (replace-match ,replace t nil str))
+ (error (concat str ": substitution failed")))
+ str)
+ lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
@@ -598,9 +595,8 @@ that `ls -l' will show in the first column of its display."
(goto-char (1+ end)))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (split-string str ,sep))) lst))))
+ (lambda (str)
+ (split-string str ,sep)) lst))))
(provide 'em-pred)
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 9ae5ae1..dcee1e7 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -48,10 +48,9 @@ as is common with most shells."
(autoload 'eshell/pwd "em-dirs")
(defcustom eshell-prompt-function
- (function
- (lambda ()
- (concat (abbreviate-file-name (eshell/pwd))
- (if (= (user-uid) 0) " # " " $ "))))
+ (lambda ()
+ (concat (abbreviate-file-name (eshell/pwd))
+ (if (= (user-uid) 0) " # " " $ ")))
"A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f173c8d..a28bb1d 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -94,10 +94,9 @@ it to get a real sense of how it works."
(defcustom eshell-smart-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'window-configuration-change-hook
- 'eshell-refresh-windows))))
+ (lambda ()
+ (remove-hook 'window-configuration-change-hook
+ 'eshell-refresh-windows)))
"A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
@@ -186,9 +185,8 @@ The options are `begin', `after' or `end'."
(make-local-variable 'eshell-smart-command-done)
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-smart-command-done t)))
+ (lambda ()
+ (setq eshell-smart-command-done t))
t t)
(unless (eq eshell-review-quick-commands t)
@@ -208,13 +206,12 @@ The options are `begin', `after' or `end'."
"Refresh all visible Eshell buffers."
(let (affected)
(walk-windows
- (function
- (lambda (wind)
- (with-current-buffer (window-buffer wind)
- (if eshell-mode
- (let (window-scroll-functions) ;;FIXME: Why?
- (eshell-smart-scroll-window wind (window-start))
- (setq affected t))))))
+ (lambda (wind)
+ (with-current-buffer (window-buffer wind)
+ (if eshell-mode
+ (let (window-scroll-functions) ;;FIXME: Why?
+ (eshell-smart-scroll-window wind (window-start))
+ (setq affected t)))))
0 frame)
(if affected
(let (window-scroll-functions) ;;FIXME: Why?
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 937b8bf..1881864 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.")
(apply 'eshell-shuffle-files
command action
(mapcar
- (function
- (lambda (file)
- (concat source "/" file)))
+ (lambda (file)
+ (concat source "/" file))
(directory-files source))
target func t args)
(when (eq func 'rename-file)
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index e7b07b4..aefda64 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -85,51 +85,48 @@ If POS is nil, the location of point is checked."
'eshell-parse-special-reference
;; numbers convert to numbers if they stand alone
- (function
- (lambda ()
- (when (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at eshell-number-regexp)
- (eshell-arg-delimiter (match-end 0)))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if (> (length str) 0)
- (add-text-properties 0 (length str) '(number t) str))
- str))))
+ (lambda ()
+ (when (and (not eshell-current-argument)
+ (not eshell-current-quoted)
+ (looking-at eshell-number-regexp)
+ (eshell-arg-delimiter (match-end 0)))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if (> (length str) 0)
+ (add-text-properties 0 (length str) '(number t) str))
+ str)))
;; parse any non-special characters, based on the current context
- (function
- (lambda ()
- (unless eshell-inside-quote-regexp
- (setq eshell-inside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-inside-quoting))))
- (unless eshell-outside-quote-regexp
- (setq eshell-outside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-outside-quoting))))
- (when (looking-at (if eshell-current-quoted
- eshell-inside-quote-regexp
- eshell-outside-quote-regexp))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if str
- (set-text-properties 0 (length str) nil str))
- str))))
+ (lambda ()
+ (unless eshell-inside-quote-regexp
+ (setq eshell-inside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-inside-quoting))))
+ (unless eshell-outside-quote-regexp
+ (setq eshell-outside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-outside-quoting))))
+ (when (looking-at (if eshell-current-quoted
+ eshell-inside-quote-regexp
+ eshell-outside-quote-regexp))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if str
+ (set-text-properties 0 (length str) nil str))
+ str)))
;; whitespace or a comment is an argument delimiter
- (function
- (lambda ()
- (let (comment-p)
- (when (or (looking-at "[ \t]+")
- (and (not eshell-current-argument)
- (looking-at "#\\([^<'].*\\|$\\)")
- (setq comment-p t)))
- (if comment-p
- (add-text-properties (match-beginning 0) (match-end 0)
- '(comment t)))
- (goto-char (match-end 0))
- (eshell-finish-arg)))))
+ (lambda ()
+ (let (comment-p)
+ (when (or (looking-at "[ \t]+")
+ (and (not eshell-current-argument)
+ (looking-at "#\\([^<'].*\\|$\\)")
+ (setq comment-p t)))
+ (if comment-p
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(comment t)))
+ (goto-char (match-end 0))
+ (eshell-finish-arg))))
;; parse backslash and the character after
'eshell-parse-backslash
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index e0348ba..68b3483 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -304,10 +304,9 @@ otherwise t.")
;; situation can occur, for example, if a Lisp function results in
;; `debug' being called, and the user then types \\[top-level]
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-current-command nil
- eshell-last-async-proc nil)))
+ (lambda ()
+ (setq eshell-current-command nil
+ eshell-last-async-proc nil))
nil t)
(add-hook 'eshell-parse-argument-hook
@@ -355,18 +354,17 @@ hooks should be run before and after the command."
args))
(commands
(mapcar
- (function
- (lambda (cmd)
- (setq cmd
- (if (or (not (car eshell--sep-terms))
- (string= (car eshell--sep-terms) ";"))
- (eshell-parse-pipeline cmd)
- `(eshell-do-subjob
- (list ,(eshell-parse-pipeline cmd)))))
- (setq eshell--sep-terms (cdr eshell--sep-terms))
- (if eshell-in-pipeline-p
- cmd
- `(eshell-trap-errors ,cmd))))
+ (lambda (cmd)
+ (setq cmd
+ (if (or (not (car eshell--sep-terms))
+ (string= (car eshell--sep-terms) ";"))
+ (eshell-parse-pipeline cmd)
+ `(eshell-do-subjob
+ (list ,(eshell-parse-pipeline cmd)))))
+ (setq eshell--sep-terms (cdr eshell--sep-terms))
+ (if eshell-in-pipeline-p
+ cmd
+ `(eshell-trap-errors ,cmd)))
(eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
@@ -920,7 +918,7 @@ at the moment are:
(funcall pred name))
(throw 'simple nil)))
t))
- (fboundp (intern-soft (concat "eshell/" name))))))
+ (eshell-find-alias-function name))))
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index e0e8634..a80c2fc 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -742,13 +742,12 @@ This function should be a pre-command hook."
(if (eq scroll 'this)
(goto-char (point-max))
(walk-windows
- (function
- (lambda (window)
- (when (and (eq (window-buffer window) current)
- (or (eq scroll t) (eq scroll 'all)))
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
+ (lambda (window)
+ (when (and (eq (window-buffer window) current)
+ (or (eq scroll t) (eq scroll 'all)))
+ (select-window window)
+ (goto-char (point-max))
+ (select-window selected)))
nil t))))))
;;; jww (1999-10-23): this needs testing
@@ -764,29 +763,28 @@ This function should be in the list
`eshell-output-filter-functions'."
(scroll eshell-scroll-to-bottom-on-output))
(unwind-protect
(walk-windows
- (function
- (lambda (window)
- (if (eq (window-buffer window) current)
- (progn
- (select-window window)
- (if (and (< (point) eshell-last-output-end)
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this)
- (eq selected window))
- (and (eq scroll 'others)
- (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (>= (point) eshell-last-output-start)))
- (goto-char eshell-last-output-end))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and eshell-scroll-show-maximum-output
- (>= (point) eshell-last-output-end))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))
- (select-window selected)))))
+ (lambda (window)
+ (if (eq (window-buffer window) current)
+ (progn
+ (select-window window)
+ (if (and (< (point) eshell-last-output-end)
+ (or (eq scroll t) (eq scroll 'all)
+ ;; Maybe user wants point to jump to end.
+ (and (eq scroll 'this)
+ (eq selected window))
+ (and (eq scroll 'others)
+ (not (eq selected window)))
+ ;; If point was at the end, keep it at end.
+ (>= (point) eshell-last-output-start)))
+ (goto-char eshell-last-output-end))
+ ;; Optionally scroll so that the text
+ ;; ends at the bottom of the window.
+ (if (and eshell-scroll-show-maximum-output
+ (>= (point) eshell-last-output-end))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter -1)))
+ (select-window selected))))
nil t)
(set-buffer current))))
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 45c4c9e..10994ba 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers."
:type (append
(list 'set ':tag "Supported modules")
(mapcar
- (function
- (lambda (modname)
- (let ((modsym (intern modname)))
- (list 'const
- ':tag (format "%s -- %s" modname
- (get modsym 'custom-tag))
- ':link (caar (get modsym 'custom-links))
- ':doc (concat "\n" (get modsym 'group-documentation)
- "\n ")
- modsym))))
+ (lambda (modname)
+ (let ((modsym (intern modname)))
+ (list 'const
+ ':tag (format "%s -- %s" modname
+ (get modsym 'custom-tag))
+ ':link (caar (get modsym 'custom-links))
+ ':doc (concat "\n" (get modsym 'group-documentation)
+ "\n ")
+ modsym)))
(sort (mapcar 'symbol-name
(eshell-subgroups 'eshell-module))
'string-lessp))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index db1b258..4a1001b 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -215,9 +215,8 @@ and signal names."
The prompt will be set to PROMPT."
(completing-read prompt
(mapcar
- (function
- (lambda (proc)
- (cons (process-name proc) t)))
+ (lambda (proc)
+ (cons (process-name proc) t))
(process-list))
nil t))
@@ -499,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'."
(let ((sigs eshell-kill-process-signals))
(while sigs
(eshell-process-interact
- (function
- (lambda (proc)
- (signal-process (process-id proc) (car sigs)))) t query)
+ (lambda (proc)
+ (signal-process (process-id proc) (car sigs))) t query)
(setq query nil)
(if (not eshell-process-list)
(setq sigs nil)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 7388279..f91fb89 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -382,9 +382,8 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
- (mapcar (function
- (lambda (x)
- (substring x 0 (string-match "=" x))))
+ (mapcar (lambda (x)
+ (substring x 0 (string-match "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
@@ -618,14 +617,13 @@ For example, to retrieve the second element of a user's
record in
(sort
(append
(mapcar
- (function
- (lambda (varname)
- (let ((value (eshell-get-variable varname)))
- (if (and value
- (stringp value)
- (file-directory-p value))
- (concat varname "/")
- varname))))
+ (lambda (varname)
+ (let ((value (eshell-get-variable varname)))
+ (if (and value
+ (stringp value)
+ (file-directory-p value))
+ (concat varname "/")
+ varname)))
(eshell-envvar-names (eshell-environment-variables)))
(all-completions argname obarray 'boundp)
completions)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index bf03588..d4bddd0 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -301,15 +301,14 @@ disable ffap most of the time."
:version "20.3")
-;;; Compatibility:
-;;
-;; This version of ffap supports only the Emacs it is distributed in.
-;; See the ftp site for a more general version. The following
-;; functions are necessary "leftovers" from the more general version.
+;;; Obsolete:
(defun ffap-mouse-event () ; current mouse event, or nil
+ (declare (obsolete nil "28.1"))
(and (listp last-nonmenu-event) last-nonmenu-event))
+
(defun ffap-event-buffer (event)
+ (declare (obsolete nil "28.1"))
(window-buffer (car (event-start event))))
@@ -690,14 +689,13 @@ Optional DEPTH limits search depth."
(setq depth (1- depth))
(cons dir
(and (not (eq depth -1))
- (apply 'nconc
+ (apply #'nconc
(mapcar
- (function
- (lambda (d)
- (cond
- ((not (file-directory-p d)) nil)
- ((file-symlink-p d) (list d))
- (t (ffap-all-subdirs-loop d depth)))))
+ (lambda (d)
+ (cond
+ ((not (file-directory-p d)) nil)
+ ((file-symlink-p d) (list d))
+ (t (ffap-all-subdirs-loop d depth))))
(directory-files dir t "\\`[^.]")
)))))
@@ -710,13 +708,12 @@ Set to 0 to avoid all searching, or nil for no limit.")
The subdirs begin with the original directory, and the depth of the
search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
kpathsea, a library used by some versions of TeX."
- (apply 'nconc
+ (apply #'nconc
(mapcar
- (function
- (lambda (dir)
- (if (string-match "[^/]//\\'" dir)
- (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
- (list dir))))
+ (lambda (dir)
+ (if (string-match "[^/]//\\'" dir)
+ (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
+ (list dir)))
path)))
(defun ffap-locate-file (file nosuffix path)
@@ -1738,7 +1735,9 @@ Function CONT is applied to the entry chosen by the user."
(let (choice)
(cond
;; Emacs mouse:
- ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
+ ((and (fboundp 'x-popup-menu)
+ (listp last-nonmenu-event)
+ last-nonmenu-event)
(setq choice
(x-popup-menu
t
@@ -1793,8 +1792,7 @@ Applies `ffap-menu-text-plist' text properties at all
matches."
;; Remove duplicates.
(setq ffap-menu-alist ; sort by item
(sort ffap-menu-alist
- (function
- (lambda (a b) (string-lessp (car a) (car b))))))
+ (lambda (a b) (string-lessp (car a) (car b)))))
(let ((ptr ffap-menu-alist)) ; remove duplicates
(while (cdr ptr)
(if (equal (car (car ptr)) (car (car (cdr ptr))))
@@ -1802,8 +1800,7 @@ Applies `ffap-menu-text-plist' text properties at all
matches."
(setq ptr (cdr ptr)))))
(setq ffap-menu-alist ; sort by position
(sort ffap-menu-alist
- (function
- (lambda (a b) (< (cdr a) (cdr b)))))))
+ (lambda (a b) (< (cdr a) (cdr b))))))
;;; Mouse Support (`ffap-at-mouse'):
@@ -1833,7 +1830,7 @@ Return value:
(ffap-guesser))))
(cond
(guess
- (set-buffer (ffap-event-buffer e))
+ (set-buffer (window-buffer (car (event-start e))))
(ffap-highlight)
(unwind-protect
(progn
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 911e7ba..620a2e2 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables."
;; No connection-local variables to apply.
,@body))
+;;;###autoload
+(defun path-separator ()
+ "The connection-local value of `path-separator'."
+ (with-connection-local-variables path-separator))
+
+;;;###autoload
+(defun null-device ()
+ "The connection-local value of `null-device'."
+ (with-connection-local-variables null-device))
+
(provide 'files-x)
diff --git a/lisp/files.el b/lisp/files.el
index 92c9a63..7777259 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2315,53 +2315,52 @@ the various files."
;; hexl-mode or image-mode.
(memq major-mode '(hexl-mode image-mode)))
(if (buffer-modified-p)
- (if (y-or-n-p
- (format
- (if rawfile
- "The file %s is already visited normally,
+ (if (let ((help-form
+ (format-message
+ (if rawfile "\
+The file %s is already visited normally,
and you have edited the buffer. Now you have asked to visit it literally,
meaning no coding system handling, format conversion, or local variables.
-Emacs can visit a file in only one way at a time.
-
-Do you want to save the file, and visit it literally instead? "
- "The file %s is already visited literally,
+Emacs can visit a file in only one way at a time."
+ "\
+The file %s is already visited literally,
meaning no coding system handling, format conversion, or local variables.
You have edited the buffer. Now you have asked to visit the file normally,
-but Emacs can visit a file in only one way at a time.
-
-Do you want to save the file, and visit it normally instead? ")
- (file-name-nondirectory filename)))
+but Emacs can visit a file in only one way at a time.")
+ (file-name-nondirectory filename))))
+ (y-or-n-p
+ (if rawfile "\
+Do you want to save the file, and visit it literally instead? " "\
+Do you want to save the file, and visit it normally instead? ")))
(progn
(save-buffer)
(find-file-noselect-1 buf filename nowarn
rawfile truename number))
(if (y-or-n-p
- (format
- (if rawfile
- "\
-Do you want to discard your changes, and visit the file literally now? "
- "\
-Do you want to discard your changes, and visit the file normally now? ")))
+ (if rawfile "\
+Do you want to discard your changes, and visit the file literally now? " "\
+Do you want to discard your changes, and visit the file normally now? "))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited
non-literally"
"File already visited literally"))))
- (if (y-or-n-p
- (format
- (if rawfile
- "The file %s is already visited normally.
+ (if (let ((help-form
+ (format-message
+ (if rawfile "\
+The file %s is already visited normally.
You have asked to visit it literally,
meaning no coding system decoding, format conversion, or local variables.
-But Emacs can visit a file in only one way at a time.
-
-Do you want to revisit the file literally now? "
- "The file %s is already visited literally,
+But Emacs can visit a file in only one way at a time."
+ "\
+The file %s is already visited literally,
meaning no coding system decoding, format conversion, or local variables.
You have asked to visit it normally,
-but Emacs can visit a file in only one way at a time.
-
-Do you want to revisit the file normally now? ")
- (file-name-nondirectory filename)))
+but Emacs can visit a file in only one way at a time.")
+ (file-name-nondirectory filename))))
+ (y-or-n-p
+ (if rawfile "\
+Do you want to revisit the file literally now? " "\
+Do you want to revisit the file normally now? ")))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
@@ -7375,9 +7374,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil,
calls it."
(save-some-buffers arg t)
(let ((confirm confirm-kill-emacs))
(and
- (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
+ (or (not (memq t (mapcar (lambda (buf)
+ (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
(buffer-list))))
(progn (setq confirm nil)
(yes-or-no-p "Modified buffers exist; exit anyway? ")))
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 2cad202..c7ec3f7 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -89,6 +89,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'easymenu)
;;; Some variables
@@ -308,7 +309,7 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
-See `add-submenu' for documentation."
+See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
@@ -317,7 +318,7 @@ See `add-submenu' for documentation."
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
-See `add-submenu' for documentation."
+See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
@@ -326,7 +327,7 @@ See `add-submenu' for documentation."
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
-See `add-submenu' for documentation."
+See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type 'sexp
:group 'filesets)
@@ -1075,18 +1076,6 @@ defined in `filesets-ingroup-patterns'."
:type 'integer
:group 'filesets)
-;;; Emacs compatibility
-(eval-and-compile
- (if (featurep 'xemacs)
- (fset 'filesets-error 'error)
-
- (require 'easymenu)
-
- (defun filesets-error (_class &rest args)
- "`error' wrapper."
- (error "%s" (mapconcat 'identity args " ")))
-
- ))
(defun filesets-filter-dir-names (lst &optional negative)
"Remove non-directory names from a list of strings.
@@ -1160,7 +1149,7 @@ Return full path if FULL-FLAG is non-nil."
(filesets-message 1 "Filesets: %S doesn't exist" dir)
nil)
(t
- (filesets-error 'error "Filesets: " dir " does not exist"))))
+ (error "Filesets: %s does not exist" dir))))
(defun filesets-quote (txt)
"Return TXT in quotes."
@@ -1172,7 +1161,7 @@ Return full path if FULL-FLAG is non-nil."
(p (point)))
(if m
(buffer-substring (min m p) (max m p))
- (filesets-error 'error "No selection."))))
+ (error "No selection"))))
(defun filesets-get-quoted-selection ()
"Return the currently selected text in quotes."
@@ -1357,8 +1346,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
(goto-char (point-min)))
(when oh
(run-hooks 'oh))))
- (filesets-error 'error
- "Filesets: general error when spawning external
viewer"))))
+ (error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
"Call `find-file' after a possible delay (see `filesets-find-file-delay').
@@ -1741,8 +1729,7 @@ Assume MODE (see `filesets-entry-mode'), if provided."
;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
(filesets-directory-files dir patt ':files t))
;; (message "Filesets: malformed entry: %s" entry)))))))
- (filesets-error 'error "Filesets: malformed entry: "
- entry)))))))
+ (error "Filesets: malformed entry: %s" entry)))))))
(filesets-filter-list fl
(lambda (file)
(not (filesets-filetype-property file event))))))
@@ -1768,7 +1755,7 @@ Use LOOKUP-NAME for searching additional data if
provided."
(dolist (this files nil)
(filesets-file-open open-function this))
(message "Filesets: canceled")))
- (filesets-error 'error "Filesets: Unknown fileset: " name))))
+ (error "Filesets: Unknown fileset: %s" name))))
(defun filesets-close (&optional mode name lookup-name)
"Close all buffers belonging to the fileset called NAME.
@@ -1789,7 +1776,7 @@ Use LOOKUP-NAME for deducing the save-function, if
provided."
(if buffer
(filesets-file-close save-function buffer)))))
; (message "Filesets: Unknown fileset: `%s'" name))))
- (filesets-error 'error "Filesets: Unknown fileset: " name))))
+ (error "Filesets: Unknown fileset: %s" name))))
(defun filesets-add-buffer (&optional name buffer)
"Add BUFFER (or current buffer) to the fileset called NAME.
@@ -1997,7 +1984,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset
specific settings."
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
(_
- (filesets-error 'error "Filesets: malformed definition of " something))))
+ (error "Filesets: malformed definition of %s" something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
"Access to `filesets-ingroup-patterns'. Extract data section."
@@ -2070,8 +2057,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset
specific settings."
(lst nil))
(cond
((not this-patt)
- (filesets-error 'error "Filesets: malformed :ingroup definition
"
- this-def))
+ (error "Filesets: malformed :ingroup definition %s" this-def))
((< this-sd 0)
nil)
(t
@@ -2174,7 +2160,7 @@ FS is a fileset's name. FLIST is a list returned by
(progn
(message "Filesets: can't parse %s" master)
nil)
- (filesets-error 'error "Filesets: can't parse " master))))
+ (error "Filesets: can't parse %s" master))))
(defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt
fd
&optional rebuild-flag)
@@ -2349,21 +2335,20 @@ bottom up, set `filesets-submenus' to nil, first.)"
(filesets-menu-cache-file-save-maybe)))
(let ((cb (current-buffer)))
(when (not (member cb filesets-updated-buffers))
- (add-submenu
- filesets-menu-path
- `(,filesets-menu-name
- ("# Filesets"
- ["Edit Filesets" filesets-edit]
- ["Save Filesets" filesets-save-config]
- ["Save Menu Cache" filesets-menu-cache-file-save]
- ["Rebuild Menu" filesets-build-menu]
- ["Customize" filesets-customize]
- ["About" filesets-info])
- ,(filesets-get-cmd-menu)
- "---"
- ,@filesets-menu-cache)
- filesets-menu-before
- filesets-menu-in-menu)
+ (easy-menu-add-item (or filesets-menu-in-menu (current-global-map))
+ (cons "menu-bar" filesets-menu-path)
+ `(,filesets-menu-name
+ ("# Filesets"
+ ["Edit Filesets" filesets-edit]
+ ["Save Filesets" filesets-save-config]
+ ["Save Menu Cache" filesets-menu-cache-file-save]
+ ["Rebuild Menu" filesets-build-menu]
+ ["Customize" filesets-customize]
+ ["About" filesets-info])
+ ,(filesets-get-cmd-menu)
+ "---"
+ ,@filesets-menu-cache)
+ filesets-menu-before)
(setq filesets-updated-buffers
(cons cb filesets-updated-buffers))
;; This wipes out other messages in the echo area.
@@ -2474,7 +2459,7 @@ We apologize for the inconvenience.")))
(insert msg)
(when (y-or-n-p (format "Edit startup (%s) file now? " cf))
(find-file-other-window cf))
- (filesets-error 'error msg))))
+ (error msg))))
(defun filesets-update (cached-version)
"Do some cleanup after updating filesets.el."
@@ -2510,8 +2495,7 @@ We apologize for the inconvenience.")))
(defun filesets-init ()
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
- (add-hook (if (featurep 'xemacs) 'activate-menubar-hook
'menu-bar-update-hook)
- (function filesets-build-menu-maybe))
+ (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
(add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
(add-hook 'first-change-hook (function filesets-reset-filename-on-change))
(add-hook 'kill-emacs-hook (function filesets-exit))
@@ -2525,6 +2509,10 @@ Set up hooks, load the cache file -- if existing -- and
build the menu."
(setq filesets-menu-use-cached-flag t)))
(filesets-build-menu)))
+(defun filesets-error (_class &rest args)
+ "`error' wrapper."
+ (declare (obsolete error "28.1"))
+ (error "%s" (mapconcat 'identity args " ")))
(provide 'filesets)
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index 3527204..c1be5ff 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -221,15 +221,12 @@ It is a function which takes two arguments, the directory
and its parent."
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function
- (function
- (lambda (_ignore1 _ignore2)
- (find-lisp-insert-directory
- default-directory
- find-lisp-file-predicate
- find-lisp-directory-predicate
- 'ignore)
- )
- ))
+ (lambda (_ignore1 _ignore2)
+ (find-lisp-insert-directory
+ default-directory
+ find-lisp-file-predicate
+ find-lisp-directory-predicate
+ 'ignore)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
@@ -267,11 +264,10 @@ It is a function which takes two arguments, the directory
and its parent."
(insert find-lisp-line-indent "\n")
;; Run the find function
(mapc
- (function
- (lambda (file)
- (find-lisp-find-dired-insert-file
- (substring file len)
- (current-buffer))))
+ (lambda (file)
+ (find-lisp-find-dired-insert-file
+ (substring file len)
+ (current-buffer)))
(sort files 'string-lessp))
;; FIXME: Sort function is ignored for now
;; (funcall sort-function files))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 48ac123..5875dce 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -107,8 +107,6 @@
;;; Code:
-(eval-when-compile (require 'font-lock))
-
(defgroup generic-x nil
"A collection of generic modes."
:prefix "generic-"
@@ -280,12 +278,11 @@ your changes into effect."
("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face))
'("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
- ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
- ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
+ ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
+ ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
"Generic mode for Apache or HTTPD configuration files."))
(when (memq 'apache-log-generic-mode generic-extras-enable-list)
@@ -401,11 +398,10 @@ your changes into effect."
(2 font-lock-variable-name-face)))
'("\\.[iI][nN][iI]\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\[\\(.*\\)\\]" 1)
- ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\[\\(.*\\)\\]" 1)
+ ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))
"Generic mode for MS-Windows INI files.
You can use `ini-generic-mode-find-file-hook' to enter this mode
automatically for INI files whose names do not end in \".ini\".")
@@ -432,10 +428,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[rR][eE][gG]\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
"Generic mode for MS-Windows Registry files."))
(declare-function w32-shell-name "w32-fns" ())
@@ -456,10 +451,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face))
'("\\.rules\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
"Generic mode for Mailagent rules files."))
;; Solaris/Sys V prototype files
@@ -548,13 +542,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.wrl\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
- ("*Definitions*"
- "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
- 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
+ ("*Definitions*"
+ "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
+ 1)))))
"Generic Mode for VRML files."))
;; Java Manifests
@@ -594,20 +587,18 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; * an equal sign
;; * a colon
(mapcar
- (function
- (lambda (elt)
- (list
- (concat "^" java-properties-key elt java-properties-value "$")
- '(1 font-lock-constant-face)
- '(4 font-lock-variable-name-face))))
+ (lambda (elt)
+ (list
+ (concat "^" java-properties-key elt java-properties-value "$")
+ '(1 font-lock-constant-face)
+ '(4 font-lock-variable-name-face)))
;; These are the separators
'(":\\s-*" "\\s-+" "\\s-*=\\s-*"))))
nil
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
"Generic mode for Java properties files."))
;; C shell alias definitions
@@ -622,10 +613,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(1 font-lock-variable-name-face)))
'("alias\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
"Generic mode for C Shell alias files."))
;; Ansible inventory files
@@ -645,11 +635,10 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-keyword-face)))
'("inventory\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
- ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
+ ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
"Generic mode for Ansible inventory files."))
;;; Windows RC files
@@ -1432,10 +1421,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
'(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face))
'("/etc/inetd\\.conf\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Services
(when (memq 'etc-services-generic-mode generic-extras-enable-list)
@@ -1450,10 +1438,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("/etc/services\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Password and Group files
(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
@@ -1493,10 +1480,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow-
'("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
;; Fstab
(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
@@ -1547,10 +1533,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face t)))
'("/etc/[v]*fstab\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([^# \t]+\\)\\s-+" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
;; /etc/sudoers
(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
@@ -1710,9 +1695,8 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
- (function
- (lambda()
- (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
+ (lambda ()
+ (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for SPICE circuit netlist files."))
(when (memq 'ibis-generic-mode generic-extras-enable-list)
@@ -1758,9 +1742,8 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
- (function
- (lambda()
- (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
+ (lambda ()
+ (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for ASTAP circuit netlist files."))
(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 76c2904..053e7ea 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -3567,22 +3567,21 @@ articles in every agentized group? "))
(let* (delete-recursive
files f
(delete-recursive
- (function
- (lambda (f-or-d)
- (ignore-errors
- (if (file-directory-p f-or-d)
- (condition-case nil
- (delete-directory f-or-d)
- (file-error
- (setq files (directory-files f-or-d))
- (while files
- (setq f (pop files))
- (or (member f '("." ".."))
- (funcall delete-recursive
- (nnheader-concat
- f-or-d f))))
- (delete-directory f-or-d)))
- (delete-file f-or-d)))))))
+ (lambda (f-or-d)
+ (ignore-errors
+ (if (file-directory-p f-or-d)
+ (condition-case nil
+ (delete-directory f-or-d)
+ (file-error
+ (setq files (directory-files f-or-d))
+ (while files
+ (setq f (pop files))
+ (or (member f '("." ".."))
+ (funcall delete-recursive
+ (nnheader-concat
+ f-or-d f))))
+ (delete-directory f-or-d)))
+ (delete-file f-or-d))))))
(funcall delete-recursive dir)))))))))
;;;###autoload
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 1efc1d6..8f4ca7e 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6175,7 +6175,6 @@ If nil, don't show those extra buttons."
face ,gnus-article-button-face
follow-link t
gnus-part ,id
- button t
article-type multipart
rear-nonsticky t))
;; Do the handles
@@ -6200,6 +6199,7 @@ If nil, don't show those extra buttons."
follow-link t
gnus-part ,id
button t
+ category t
gnus-data ,handle
rear-nonsticky t))
(insert " "))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 17f1108..498da20 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -2101,9 +2101,10 @@ article came from is also searched."
(defun gnus-search--complete-key-data ()
"Potentially return completion data for a search key or value."
(let* ((key-start (save-excursion
- (if (re-search-backward " " (minibuffer-prompt-end) t)
- (1+ (point))
- (minibuffer-prompt-end))))
+ (or (re-search-backward " " (minibuffer-prompt-end) t)
+ (goto-char (minibuffer-prompt-end)))
+ (skip-chars-forward " -")
+ (point)))
(after-colon (save-excursion
(when (re-search-backward ":" key-start t)
(1+ (point)))))
@@ -2113,7 +2114,7 @@ article came from is also searched."
;; only handle in a contact-completion context.
(when (and gnus-search-contact-tables
(save-excursion
- (re-search-backward "\\<\\(\\w+\\):" key-start t)
+ (re-search-backward "\\<-?\\(\\w+\\):" key-start t)
(member (match-string 1)
'("from" "to" "cc"
"bcc" "recipient" "address"))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0782778..5bdf537 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7651,7 +7651,7 @@ Optional DIGEST will use digest to forward."
;; Consider there is no illegible text.
(add-text-properties
b (point)
- '(no-illegible-text t rear-nonsticky t start-open t))))
+ '(no-illegible-text t rear-nonsticky t))))
(defun message-forward-make-body-mml (forward-buffer)
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index dcecfcf..e53e000 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
(defun nnmairix-create-message-line-for-search ()
"Create message line for interactive query in minibuffer."
(mapconcat
- (function
- (lambda (cur)
- (format "%c=%s" (car cur) (nth 3 cur))))
+ (lambda (cur)
+ (format "%c=%s" (car cur) (nth 3 cur)))
nnmairix-interactive-query-parameters ","))
(defun nnmairix-replace-illegal-chars (header)
@@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix
version output."
(gnus-summary-toggle-header 1)
(set-buffer gnus-article-buffer)
(mapcar
- (function
- (lambda (field)
- (list (car (cddr field))
- (if (car field)
- (nnmairix-replace-illegal-chars
- (gnus-fetch-field (car field)))
- nil))))
+ (lambda (field)
+ (list (car (cddr field))
+ (if (car field)
+ (nnmairix-replace-illegal-chars
+ (gnus-fetch-field (car field)))
+ nil)))
nnmairix-widget-fields-list))))
@@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article."
(when (member 'flags nnmairix-widget-other)
(setq flag
(mapconcat
- (function
- (lambda (flag)
- (setq temp
- (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
- (if (string= "yes" temp)
- (cadr flag)
- (if (string= "no" temp)
- (concat "-" (cadr flag))))))
+ (lambda (flag)
+ (setq temp
+ (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
+ (if (string= "yes" temp)
+ (cadr flag)
+ (if (string= "no" temp)
+ (concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
@@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from
current article."
;; how can this be done less ugly?
(let ((ret))
(mapc
- (function
- (lambda (field)
- (setq field (car (cddr field)))
- (setq ret
- (nconc
- (list
- (list
- (concat "c" field)
- (widget-create 'checkbox
- :tag field
- :notify (lambda (widget &rest ignore)
- (nnmairix-widget-toggle-activate
widget))
- nil)))
- (list
- (list
- (concat "e" field)
- (widget-create 'editable-field
- :size 60
- :format (concat " " field ":"
- (make-string (- 11 (length
field)) ?\ )
- "%v")
- :value (or (cadr (assoc field values)) ""))))
- ret))
- (widget-insert "\n")
- ;; Deactivate editable field
- (widget-apply (cadr (nth 1 ret)) :deactivate)))
+ (lambda (field)
+ (setq field (car (cddr field)))
+ (setq ret
+ (nconc
+ (list
+ (list
+ (concat "c" field)
+ (widget-create 'checkbox
+ :tag field
+ :notify (lambda (widget &rest ignore)
+ (nnmairix-widget-toggle-activate
widget))
+ nil)))
+ (list
+ (list
+ (concat "e" field)
+ (widget-create 'editable-field
+ :size 60
+ :format (concat " " field ":"
+ (make-string (- 11 (length
field)) ?\ )
+ "%v")
+ :value (or (cadr (assoc field values)) ""))))
+ ret))
+ (widget-insert "\n")
+ ;; Deactivate editable field
+ (widget-apply (cadr (nth 1 ret)) :deactivate))
nnmairix-widget-fields-list)
ret))
diff --git a/lisp/help.el b/lisp/help.el
index 7eb50fd..8dac6dc 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1310,6 +1310,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
((and mention-shadow (not (eq tem definition)))
(setq this-shadowed t))
(t nil))))
+ (eq definition (lookup-key tail (vector event) t))
(push (list event definition this-shadowed) vect))))
((eq (car tail) 'keymap)
;; The same keymap might be in the structure twice, if
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 80c5b07..7934297 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -208,11 +208,9 @@ either clicking or hitting return "
'follow-link t
'help-echo "Click or RET: save new value in customize"
'action (lambda (_)
- (if (not (fboundp 'customize-save-variable))
- (message "Customize not available; value not saved")
- (customize-save-variable 'ibuffer-saved-filters
- ibuffer-saved-filters)
- (message "Saved updated ibuffer-saved-filters."))))
+ (customize-save-variable 'ibuffer-saved-filters
+ ibuffer-saved-filters)
+ (message "Saved updated ibuffer-saved-filters.")))
". See below for
an explanation and alternative ways to save the repaired value.
@@ -1116,13 +1114,10 @@ filter into parts."
(defun ibuffer-maybe-save-stuff ()
(when ibuffer-save-with-custom
- (if (fboundp 'customize-save-variable)
- (progn
- (customize-save-variable 'ibuffer-saved-filters
- ibuffer-saved-filters)
- (customize-save-variable 'ibuffer-saved-filter-groups
- ibuffer-saved-filter-groups))
- (message "Not saved permanently: Customize not available"))))
+ (customize-save-variable 'ibuffer-saved-filters
+ ibuffer-saved-filters)
+ (customize-save-variable 'ibuffer-saved-filter-groups
+ ibuffer-saved-filter-groups)))
;;;###autoload
(defun ibuffer-save-filters (name filters)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 1e6fea8..d361971 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -441,56 +441,55 @@ non-nil, it is used to sort CODINGS instead."
(most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
- (func (function
- (lambda (x)
- (let ((base (coding-system-base x)))
- ;; We calculate the priority number 0..255 by
- ;; using the 8 bits PMMLCEII as this:
- ;; P: 1 if most preferred.
- ;; MM: greater than 0 if mime-charset.
- ;; L: 1 if one of the current lang. env.'s codings.
- ;; C: 1 if one of codings listed in the category list.
- ;; E: 1 if not XXX-with-esc
- ;; II: if iso-2022 based, 0..3, else 1.
- (logior
- (ash (if (eq base most-preferred) 1 0) 7)
- (ash
- (let ((mime (coding-system-get base :mime-charset)))
- ;; Prefer coding systems corresponding to a
- ;; MIME charset.
- (if mime
- ;; Lower utf-16 priority so that we
- ;; normally prefer utf-8 to it, and put
- ;; x-ctext below that.
- (cond ((string-match-p "utf-16"
- (symbol-name mime))
- 2)
- ((string-match-p "^x-" (symbol-name mime))
- 1)
- (t 3))
- 0))
- 5)
- (ash (if (memq base lang-preferred) 1 0) 4)
- (ash (if (memq base from-priority) 1 0) 3)
- (ash (if (string-match-p "-with-esc\\'"
- (symbol-name base))
- 0 1) 2)
- (if (eq (coding-system-type base) 'iso-2022)
- (let ((category (coding-system-category base)))
- ;; For ISO based coding systems, prefer
- ;; one that doesn't use designation nor
- ;; locking/single shifting.
- (cond
- ((or (eq category 'coding-category-iso-8-1)
- (eq category 'coding-category-iso-8-2))
- 2)
- ((or (eq category 'coding-category-iso-7-tight)
- (eq category 'coding-category-iso-7))
- 1)
- (t
- 0)))
- 1)
- ))))))
+ (func (lambda (x)
+ (let ((base (coding-system-base x)))
+ ;; We calculate the priority number 0..255 by
+ ;; using the 8 bits PMMLCEII as this:
+ ;; P: 1 if most preferred.
+ ;; MM: greater than 0 if mime-charset.
+ ;; L: 1 if one of the current lang. env.'s codings.
+ ;; C: 1 if one of codings listed in the category list.
+ ;; E: 1 if not XXX-with-esc
+ ;; II: if iso-2022 based, 0..3, else 1.
+ (logior
+ (ash (if (eq base most-preferred) 1 0) 7)
+ (ash
+ (let ((mime (coding-system-get base :mime-charset)))
+ ;; Prefer coding systems corresponding to a
+ ;; MIME charset.
+ (if mime
+ ;; Lower utf-16 priority so that we
+ ;; normally prefer utf-8 to it, and put
+ ;; x-ctext below that.
+ (cond ((string-match-p "utf-16"
+ (symbol-name mime))
+ 2)
+ ((string-match-p "^x-" (symbol-name mime))
+ 1)
+ (t 3))
+ 0))
+ 5)
+ (ash (if (memq base lang-preferred) 1 0) 4)
+ (ash (if (memq base from-priority) 1 0) 3)
+ (ash (if (string-match-p "-with-esc\\'"
+ (symbol-name base))
+ 0 1) 2)
+ (if (eq (coding-system-type base) 'iso-2022)
+ (let ((category (coding-system-category base)))
+ ;; For ISO based coding systems, prefer
+ ;; one that doesn't use designation nor
+ ;; locking/single shifting.
+ (cond
+ ((or (eq category 'coding-category-iso-8-1)
+ (eq category 'coding-category-iso-8-2))
+ 2)
+ ((or (eq category 'coding-category-iso-7-tight)
+ (eq category 'coding-category-iso-7))
+ 1)
+ (t
+ 0)))
+ 1)
+ )))))
(sort codings (lambda (x y)
(> (funcall func x) (funcall func y)))))))
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index b13bde5..57e5686 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
((eq sort-key 'iso-spec)
;; Sort by DIMENSION CHARS FINAL-CHAR
- (function
- (lambda (x y)
- (or (< (nth 1 x) (nth 1 y))
- (and (= (nth 1 x) (nth 1 y))
- (or (< (nth 2 x) (nth 2 y))
- (and (= (nth 2 x) (nth 2 y))
- (< (nth 3 x) (nth 3 y)))))))))
+ (lambda (x y)
+ (or (< (nth 1 x) (nth 1 y))
+ (and (= (nth 1 x) (nth 1 y))
+ (or (< (nth 2 x) (nth 2 y))
+ (and (= (nth 2 x) (nth 2 y))
+ (< (nth 3 x) (nth 3 y))))))))
(t
(error "Invalid charset sort key: %s" sort-key))))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 5abd668..39ef6d3 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1330,7 +1330,8 @@ If STR has `advice' text property, append the following
special event:
(defun quail-input-method (key)
(if (or (and (or buffer-read-only
- (get-char-property (point) 'read-only))
+ (and (get-char-property (point) 'read-only)
+ (get-char-property (point) 'front-sticky)))
(not (or inhibit-read-only
(get-char-property (point) 'inhibit-read-only))))
(and overriding-terminal-local-map
@@ -2477,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)."
'face 'font-lock-comment-face))
(quail-indent-to max-key-width)
(if (vectorp (cdr elt))
- (mapc (function
- (lambda (x)
- (let ((width (if (integerp x) (char-width x)
- (string-width x))))
- (when (> (+ (current-column) 1 width) window-width)
- (insert "\n")
- (quail-indent-to max-key-width))
- (insert " " x))))
+ (mapc (lambda (x)
+ (let ((width (if (integerp x) (char-width x)
+ (string-width x))))
+ (when (> (+ (current-column) 1 width) window-width)
+ (insert "\n")
+ (quail-indent-to max-key-width))
+ (insert " " x)))
(cdr elt))
(insert " " (cdr elt)))
(insert ?\n))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 7de6bae..0b33940 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.12
+;; Version: 1.0.14
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -271,7 +271,7 @@ it only exits locally (returning the JSONRPC result object)
if
the request is successful, otherwise it exits non-locally with an
error of type `jsonrpc-error'.
-DEFERRED is passed to `jsonrpc-async-request', which see.
+DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
the function is waiting, then it exits immediately, returning
@@ -284,7 +284,8 @@ ignored."
(catch tag
(setq
id-and-timer
- (jsonrpc--async-request-1
+ (apply
+ #'jsonrpc--async-request-1
connection method params
:success-fn (lambda (result)
(unless cancelled
@@ -300,11 +301,12 @@ ignored."
(lambda ()
(unless cancelled
(throw tag '(error (jsonrpc-error-message . "Timed
out")))))
- :deferred deferred
- :timeout timeout))
+ `(,@(when deferred `(:deferred ,deferred))
+ ,@(when timeout `(:timeout ,timeout)))))
(cond (cancel-on-input
- (while (sit-for 30))
- (setq cancelled t)
+ (unwind-protect
+ (let ((inhibit-quit t)) (while (sit-for 30)))
+ (setq cancelled t))
`(cancelled ,cancel-on-input-retval))
(t (while t (accept-process-output nil 30)))))
;; In normal operation, cancellation is handled by the
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 0c8b8d4..805dd12 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -250,14 +250,12 @@ dumped."
(insert "(setq\n")
(lisp-indent-line)
(mapc
- (function
- (lambda (varsym-or-cons-cell)
- (let ((varsym (or (car-safe varsym-or-cons-cell)
- varsym-or-cons-cell))
- (printer (or (cdr-safe varsym-or-cons-cell)
- 'reporter-dump-variable)))
- (funcall printer varsym mailbuf)
- )))
+ (lambda (varsym-or-cons-cell)
+ (let ((varsym (or (car-safe varsym-or-cons-cell)
+ varsym-or-cons-cell))
+ (printer (or (cdr-safe varsym-or-cons-cell)
+ 'reporter-dump-variable)))
+ (funcall printer varsym mailbuf)))
varlist)
(lisp-indent-line)
(insert ")\n"))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 986d0cf..9b7af01 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -618,10 +618,7 @@ the list should be unique."
(lambda (elt) (char-to-string (cdr elt))) alist "/")
") "))
(p prompt)
- (event
- (if (fboundp 'allocate-event)
- (allocate-event)
- nil)))
+ event)
(while (stringp p)
(if (let ((cursor-in-echo-area t)
(inhibit-quit t))
@@ -630,8 +627,6 @@ the list should be unique."
(prog1 quit-flag (setq quit-flag nil)))
(progn
(message "%s%s" p (single-key-description event))
- (if (fboundp 'deallocate-event)
- (deallocate-event event))
(setq quit-flag nil)
(signal 'quit '())))
(let ((char event)
@@ -650,8 +645,6 @@ the list should be unique."
(discard-input)
(if (eq p prompt)
(setq p (concat "Try again. " prompt)))))))
- (if (fboundp 'deallocate-event)
- (deallocate-event event))
p))
(defun sc-scan-info-alist (alist)
@@ -1028,17 +1021,16 @@ supplied, is used instead of the line point is on in
the current buffer."
(setq position (1+ position))
(let ((keep-p t))
(mapc
- (function
- (lambda (filter)
- (let ((regexp (car filter))
- (pos (cdr filter)))
- (if (and (string-match regexp name)
- (or (and (numberp pos)
- (= pos position))
- (and (eq pos 'last)
- (= position (1- elements)))
- (eq pos 'any)))
- (setq keep-p nil)))))
+ (lambda (filter)
+ (let ((regexp (car filter))
+ (pos (cdr filter)))
+ (if (and (string-match regexp name)
+ (or (and (numberp pos)
+ (= pos position))
+ (and (eq pos 'last)
+ (= position (1- elements)))
+ (eq pos 'any)))
+ (setq keep-p nil))))
sc-name-filter-alist)
(if keep-p
(setq keepers (cons position keepers)))))
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index cc437c3..d037bdc 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -73,12 +73,11 @@ If ARG is non-nil, set timestamp with the current time."
(setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
(let ((stamp))
(car (memq t (mapcar
- (function
- (lambda (file)
- (when (and file (file-exists-p file))
- (setq stamp (file-attribute-modification-time
- (file-attributes file)))
- (time-less-p mh-alias-tstamp stamp))))
+ (lambda (file)
+ (when (and file (file-exists-p file))
+ (setq stamp (file-attribute-modification-time
+ (file-attributes file)))
+ (time-less-p mh-alias-tstamp stamp)))
(mh-alias-filenames t)))))))
(defun mh-alias-filenames (arg)
@@ -93,11 +92,10 @@ appended."
(filelist (and filename (split-string filename "[ \t]+")))
(userlist
(mapcar
- (function
- (lambda (file)
- (if (and mh-user-path file
- (file-exists-p (expand-file-name file mh-user-path)))
- (expand-file-name file mh-user-path))))
+ (lambda (file)
+ (if (and mh-user-path file
+ (file-exists-p (expand-file-name file mh-user-path)))
+ (expand-file-name file mh-user-path)))
filelist)))
(if arg
(if (stringp mh-alias-system-aliases)
@@ -466,12 +464,11 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile
component"))
;; Double-check that we have an individual alias. This means that the
;; alias doesn't expand into a list (of which this address is part).
(car (delq nil (mapcar
- (function
- (lambda (alias)
- (let ((recurse (mh-alias-ali alias nil)))
- (if (string-match ".*,.*" recurse)
- nil
- alias))))
+ (lambda (alias)
+ (let ((recurse (mh-alias-ali alias nil)))
+ (if (string-match ".*,.*" recurse)
+ nil
+ alias)))
(split-string aliases ", +")))))))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 8a69adb..e766bca 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -435,43 +435,42 @@ See also `mh-send'."
(mh-insert-header-separator)
;; Merge in components
(mh-mapc
- (function
- (lambda (header-field)
- (let ((field (car header-field))
- (value (cdr header-field))
- (case-fold-search t))
- (cond
- ;; Address field
- ((string-match field "^To$\\|^Cc$\\|^From$")
- (cond
- ((not (mh-goto-header-field (concat field ":")))
- ;; Header field does not exist, add it
- (mh-goto-header-end 0)
- (insert field ": " value "\n"))
- ((string-equal value "")
- ;; Header field already exists and no value
- )
- (t
- ;; Header field exists and we have a value
- (let (address mailbox (alias (mh-alias-expand value)))
- (and alias
- (setq address (ietf-drums-parse-address alias))
- (setq mailbox (car address)))
- ;; XXX - Need to parse all addresses out of field
- (if (and
- (not (mh-regexp-in-field-p
- (concat "\\b" (regexp-quote value) "\\b") field))
- mailbox
- (not (mh-regexp-in-field-p
- (concat "\\b" (regexp-quote mailbox) "\\b") field)))
- (insert " " value ","))
- ))))
- ((string-match field "^Fcc$")
- ;; Folder reference
- (mh-modify-header-field field value))
- ;; Text field, that's an easy case
- (t
- (mh-modify-header-field field value))))))
+ (lambda (header-field)
+ (let ((field (car header-field))
+ (value (cdr header-field))
+ (case-fold-search t))
+ (cond
+ ;; Address field
+ ((string-match field "^To$\\|^Cc$\\|^From$")
+ (cond
+ ((not (mh-goto-header-field (concat field ":")))
+ ;; Header field does not exist, add it
+ (mh-goto-header-end 0)
+ (insert field ": " value "\n"))
+ ((string-equal value "")
+ ;; Header field already exists and no value
+ )
+ (t
+ ;; Header field exists and we have a value
+ (let (address mailbox (alias (mh-alias-expand value)))
+ (and alias
+ (setq address (ietf-drums-parse-address alias))
+ (setq mailbox (car address)))
+ ;; XXX - Need to parse all addresses out of field
+ (if (and
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote value) "\\b") field))
+ mailbox
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote mailbox) "\\b") field)))
+ (insert " " value ","))
+ ))))
+ ((string-match field "^Fcc$")
+ ;; Folder reference
+ (mh-modify-header-field field value))
+ ;; Text field, that's an easy case
+ (t
+ (mh-modify-header-field field value)))))
(mh-components-to-list components-file))
(delete-file components-file)
(goto-char (point-min))
@@ -700,25 +699,24 @@ message and scan line."
;; trumping anything in the distcomps file.
(let ((components-file (mh-bare-components mh-dist-formfile)))
(mh-mapc
- (function
- (lambda (header-field)
- (let ((field (car header-field))
- (value (cdr header-field))
- (case-fold-search t))
- (cond
- ((string-match field "^Resent-Fcc$")
- (setq comp-fcc value))
- ((string-match field "^Resent-From$")
- (or from
- (setq from value)))
- ((string-match field "^Resent-To$")
- (setq comp-to value))
- ((string-match field "^Resent-Cc$")
- (setq comp-cc value))
- ((string-match field "^Resent-Bcc$")
- (setq comp-bcc value))
- ((string-match field "^Resent-.*$")
- (mh-insert-fields field value))))))
+ (lambda (header-field)
+ (let ((field (car header-field))
+ (value (cdr header-field))
+ (case-fold-search t))
+ (cond
+ ((string-match field "^Resent-Fcc$")
+ (setq comp-fcc value))
+ ((string-match field "^Resent-From$")
+ (or from
+ (setq from value)))
+ ((string-match field "^Resent-To$")
+ (setq comp-to value))
+ ((string-match field "^Resent-Cc$")
+ (setq comp-cc value))
+ ((string-match field "^Resent-Bcc$")
+ (setq comp-bcc value))
+ ((string-match field "^Resent-.*$")
+ (mh-insert-fields field value)))))
(mh-components-to-list components-file))
(delete-file components-file))
(mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ",
")
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index ebc7d2a..ed23996 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -71,10 +71,9 @@ See `mh-identity-add-menu'."
(mh-insert-auto-fields) mh-auto-fields-list]
"--")
- (mapcar (function
- (lambda (arg)
- `[,arg (mh-insert-identity ,arg) :style radio
- :selected (equal mh-identity-local ,arg)]))
+ (mapcar (lambda (arg)
+ `[,arg (mh-insert-identity ,arg) :style radio
+ :selected (equal mh-identity-local ,arg)])
(mapcar 'car mh-identity-list))
'(["None"
(mh-insert-identity "None") :style radio
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 44b4ef4..28d3c76 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -270,9 +270,8 @@ and displayed in a help buffer."
(cdr (assoc nil (assoc major-mode mh-help-messages)))))
(text (substitute-command-keys (mapconcat 'identity help ""))))
(with-electric-help
- (function
- (lambda ()
- (insert text)))
+ (lambda ()
+ (insert text))
mh-help-buffer)))
;;;###mh-autoload
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index f369991..da4ea405 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -127,10 +127,8 @@ Buffer should contain output generated by `dig-invoke'."
"Major mode for displaying dig output."
(buffer-disable-undo)
(setq-local font-lock-defaults '(dig-font-lock-keywords t))
- (when (featurep 'font-lock)
- ;; FIXME: what is this for?? --Stef
- (font-lock-set-defaults))
- )
+ ;; FIXME: what is this for?? --Stef M
+ (font-lock-set-defaults))
(defun dig-exit ()
"Quit dig output buffer."
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index bb66825..b2069ed 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -153,9 +153,7 @@ display a button."
'end-glyph (if inline glyph)
'duplicable t
'invisible inline
- 'start-open t
- 'end-open t
- 'object-data data))))
+ 'object-data data))))
((fboundp 'create-image)
(let* ((image (create-image data nil t))
(props (list 'object-data data 'eudc-image image)))
@@ -192,9 +190,7 @@ display a button."
eudc-bob-sound-keymap
eudc-bob-sound-menu
(list 'duplicable t
- 'start-open t
- 'end-open t
- 'object-data data)))
+ 'object-data data)))
(defun eudc-bob-display-generic-binary (data)
"Display a button for unidentified binary DATA."
@@ -202,9 +198,7 @@ display a button."
eudc-bob-generic-keymap
eudc-bob-generic-menu
(list 'duplicable t
- 'start-open t
- 'end-open t
- 'object-data data)))
+ 'object-data data)))
(defun eudc-bob-play-sound-at-point ()
"Play the sound data contained in the button at point."
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index ba86958..5c96628 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not
displayed."
record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
- (mapcar (function
- (lambda (mapping)
- (if (and (not (memq (car mapping)
- '(name company
net address phone notes)))
- (setq value (eudc-parse-spec
(cdr mapping) record nil)))
- (cons (car mapping) value))))
+ (mapcar (lambda (mapping)
+ (if (and (not (memq (car mapping)
+ '(name company
net address phone notes)))
+ (setq value (eudc-parse-spec
(cdr mapping) record nil)))
+ (cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 08cab4f..f4e4c17 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD."
(eval (list (cdr match) val))
(insert "\n"))
(mapc
- (function
- (lambda (val-elem)
- (indent-to col)
- (insert val-elem "\n")))
+ (lambda (val-elem)
+ (indent-to col)
+ (insert val-elem "\n"))
(cond
((listp val) val)
((stringp val) (split-string val "\n"))
@@ -464,37 +463,33 @@ otherwise they are formatted according to
`eudc-user-attribute-names-alist'."
;; Replace field names with user names, compute max width
(setq precords
(mapcar
- (function
- (lambda (record)
- (mapcar
- (function
- (lambda (field)
- (setq attribute-name
- (if raw-attr-names
- (symbol-name (car field))
- (eudc-format-attribute-name-for-display (car
field))))
- (if (> (length attribute-name) width)
- (setq width (length attribute-name)))
- (cons attribute-name (cdr field))))
- record)))
+ (lambda (record)
+ (mapcar
+ (lambda (field)
+ (setq attribute-name
+ (if raw-attr-names
+ (symbol-name (car field))
+ (eudc-format-attribute-name-for-display (car
field))))
+ (if (> (length attribute-name) width)
+ (setq width (length attribute-name)))
+ (cons attribute-name (cdr field)))
+ record))
records))
;; Display the records
(setq first-record (point))
(mapc
- (function
- (lambda (record)
- (setq beg (point))
- ;; Map over the record fields to print the attribute/value pairs
- (mapc (function
- (lambda (field)
- (eudc-print-record-field field width)))
- record)
- ;; Store the record internal format in some convenient place
- (overlay-put (make-overlay beg (point))
- 'eudc-record
- (car records))
- (setq records (cdr records))
- (insert "\n")))
+ (lambda (record)
+ (setq beg (point))
+ ;; Map over the record fields to print the attribute/value pairs
+ (mapc (lambda (field)
+ (eudc-print-record-field field width))
+ record)
+ ;; Store the record internal format in some convenient place
+ (overlay-put (make-overlay beg (point))
+ 'eudc-record
+ (car records))
+ (setq records (cdr records))
+ (insert "\n"))
precords))
(insert "\n")
(widget-create 'push-button
@@ -518,12 +513,11 @@ otherwise they are formatted according to
`eudc-user-attribute-names-alist'."
(if (not (and (boundp 'eudc-form-widget-list)
eudc-form-widget-list))
(error "Not in a directory query form buffer")
- (mapc (function
- (lambda (wid-field)
- (setq value (widget-value (cdr wid-field)))
- (if (not (string= value ""))
- (setq query-alist (cons (cons (car wid-field) value)
- query-alist)))))
+ (mapc (lambda (wid-field)
+ (setq value (widget-value (cdr wid-field)))
+ (if (not (string= value ""))
+ (setq query-alist (cons (cons (car wid-field) value)
+ query-alist))))
eudc-form-widget-list)
(kill-buffer (current-buffer))
(eudc-display-records (eudc-query query-alist)
eudc-use-raw-directory-names))))
@@ -543,49 +537,47 @@ otherwise they are formatted according to
`eudc-user-attribute-names-alist'."
(if (null (cdar rec))
(list record) ; No duplicate attrs in this record
- (mapc (function
- (lambda (field)
- (if (listp (cdr field))
- (setq duplicates (cons field duplicates))
- (setq unique (cons field unique)))))
+ (mapc (lambda (field)
+ (if (listp (cdr field))
+ (setq duplicates (cons field duplicates))
+ (setq unique (cons field unique))))
record)
(setq result (list unique))
;; Map over the record fields that have multiple values
(mapc
- (function
- (lambda (field)
- (let ((method (if (consp eudc-duplicate-attribute-handling-method)
- (cdr
- (assq
- (or
- (car
- (rassq
- (car field)
- (symbol-value
- eudc-protocol-attributes-translation-alist)))
- (car field))
- eudc-duplicate-attribute-handling-method))
- eudc-duplicate-attribute-handling-method)))
- (cond
- ((or (null method) (eq 'list method))
- (setq result
- (eudc-add-field-to-records field result)))
- ((eq 'first method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (cadr field))
- result)))
- ((eq 'concat method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (mapconcat
- #'identity
- (cdr field)
- "\n"))
- result)))
- ((eq 'duplicate method)
- (setq result
- (eudc-distribute-field-on-records field result)))))))
+ (lambda (field)
+ (let ((method (if (consp eudc-duplicate-attribute-handling-method)
+ (cdr
+ (assq
+ (or
+ (car
+ (rassq
+ (car field)
+ (symbol-value
+ eudc-protocol-attributes-translation-alist)))
+ (car field))
+ eudc-duplicate-attribute-handling-method))
+ eudc-duplicate-attribute-handling-method)))
+ (cond
+ ((or (null method) (eq 'list method))
+ (setq result
+ (eudc-add-field-to-records field result)))
+ ((eq 'first method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (cadr field))
+ result)))
+ ((eq 'concat method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (mapconcat
+ #'identity
+ (cdr field)
+ "\n"))
+ result)))
+ ((eq 'duplicate method)
+ (setq result
+ (eudc-distribute-field-on-records field result))))))
duplicates)
result)))
@@ -593,19 +585,17 @@ otherwise they are formatted according to
`eudc-user-attribute-names-alist'."
"Eliminate records that do not contain all ATTRS from RECORDS."
(delq nil
(mapcar
- (function
- (lambda (rec)
- (if (cl-every (lambda (attr)
- (consp (assq attr rec)))
- attrs)
- rec)))
+ (lambda (rec)
+ (if (cl-every (lambda (attr)
+ (consp (assq attr rec)))
+ attrs)
+ rec))
records)))
(defun eudc-add-field-to-records (field records)
"Add FIELD to each individual record in RECORDS and return the resulting
list."
- (mapcar (function
- (lambda (r)
- (cons field r)))
+ (mapcar (lambda (r)
+ (cons field r))
records))
(defun eudc-distribute-field-on-records (field records)
@@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'."
(let ((response-string
(apply #'format
(car eudc-inline-expansion-format)
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field r))
- "")))
+ (mapcar (lambda (field)
+ (or (cdr (assq field r))
+ ""))
(eudc-translate-attribute-list
(cdr eudc-inline-expansion-format))))))
(if (> (length response-string) 0)
@@ -929,16 +918,14 @@ queries the server for the existing fields and displays a
corresponding form."
;; Build the list of prompts
(setq prompts (if eudc-use-raw-directory-names
(mapcar #'symbol-name (eudc-translate-attribute-list
fields))
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field
eudc-user-attribute-names-alist))
- (capitalize (symbol-name field)))))
+ (mapcar (lambda (field)
+ (or (cdr (assq field
eudc-user-attribute-names-alist))
+ (capitalize (symbol-name field))))
fields)))
;; Loop over prompt strings to find the longest one
- (mapc (function
- (lambda (prompt)
- (if (> (length prompt) width)
- (setq width (length prompt)))))
+ (mapc (lambda (prompt)
+ (if (> (length prompt) width)
+ (setq width (length prompt))))
prompts)
;; Insert the first widget out of the mapcar to leave the cursor
;; in the first field
@@ -949,14 +936,13 @@ queries the server for the existing fields and displays a
corresponding form."
eudc-form-widget-list))
(setq fields (cdr fields))
(setq prompts (cdr prompts))
- (mapc (function
- (lambda (field)
- (widget-insert "\n\n" (format (concat "%" (int-to-string width)
"s: ") (car prompts)))
- (setq widget (widget-create 'editable-field
- :size 15))
- (setq eudc-form-widget-list (cons (cons field widget)
- eudc-form-widget-list))
- (setq prompts (cdr prompts))))
+ (mapc (lambda (field)
+ (widget-insert "\n\n" (format (concat "%" (int-to-string width)
"s: ") (car prompts)))
+ (setq widget (widget-create 'editable-field
+ :size 15))
+ (setq eudc-form-widget-list (cons (cons field widget)
+ eudc-form-widget-list))
+ (setq prompts (cdr prompts)))
fields)
(widget-insert "\n\n")
(widget-create 'push-button
@@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays
a corresponding form."
(append
'("Server")
(mapcar
- (function
- (lambda (servspec)
- (let* ((server (car servspec))
- (protocol (cdr servspec))
- (proto-name (symbol-name protocol)))
- (setq command (intern (concat "eudc-set-server-"
- server
- "-"
- proto-name)))
- (if (not (fboundp command))
- (fset command
- `(lambda ()
- (interactive)
- (eudc-set-server ,server (quote ,protocol))
- (message "Selected directory server is now %s
(%s)"
- ,server
- ,proto-name))))
- (vector (format "%s (%s)" server proto-name)
- command
- :style 'radio
- :selected `(equal eudc-server ,server)))))
+ (lambda (servspec)
+ (let* ((server (car servspec))
+ (protocol (cdr servspec))
+ (proto-name (symbol-name protocol)))
+ (setq command (intern (concat "eudc-set-server-"
+ server
+ "-"
+ proto-name)))
+ (if (not (fboundp command))
+ (fset command
+ `(lambda ()
+ (interactive)
+ (eudc-set-server ,server (quote ,protocol))
+ (message "Selected directory server is now %s
(%s)"
+ ,server
+ ,proto-name))))
+ (vector (format "%s (%s)" server proto-name)
+ command
+ :style 'radio
+ :selected `(equal eudc-server ,server))))
eudc-server-hotlist)
eudc-server-menu))
eudc-tail-menu)))
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 82e58c2..5d6b52a 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(defun eudc-bbdb-extract-phones (record)
(require 'bbdb)
- (mapcar (function
- (lambda (phone)
- (if eudc-bbdb-use-locations-as-attribute-names
- (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone)))
- (bbdb-phone-string phone))
- (cons 'phones (format "%s: %s"
- (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone))
- (bbdb-phone-string phone))))))
+ (mapcar (lambda (phone)
+ (if eudc-bbdb-use-locations-as-attribute-names
+ (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone)))
+ (bbdb-phone-string phone))
+ (cons 'phones (format "%s: %s"
+ (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone))
+ (bbdb-phone-string phone)))))
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-phone record)
(bbdb-record-phones record))))
@@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return,
defaulting to
(if (car query-attrs)
(setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
(setq query-attrs (cdr query-attrs)))
- (mapc (function
- (lambda (record)
- (setq filtered (eudc-filter-duplicate-attributes record))
- ;; If there were duplicate attributes reverse the order of the
- ;; record so the unique attributes appear first
- (if (> (length filtered) 1)
- (setq filtered (mapcar (function
- (lambda (rec)
- (reverse rec)))
- filtered)))
- (setq result (append result filtered))))
+ (mapc (lambda (record)
+ (setq filtered (eudc-filter-duplicate-attributes record))
+ ;; If there were duplicate attributes reverse the order of the
+ ;; record so the unique attributes appear first
+ (if (> (length filtered) 1)
+ (setq filtered (mapcar (lambda (rec)
+ (reverse rec))
+ filtered)))
+ (setq result (append result filtered)))
(delq nil
(mapcar 'eudc-bbdb-format-record-as-result
(delq nil
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 8218249..5571b2a 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer)))
(when (member 'flags mairix-widget-other)
(setq flag
(mapconcat
- (function
- (lambda (flag)
- (setq temp
- (widget-value (cadr (assoc (car flag) mairix-widgets))))
- (if (string= "yes" temp)
- (cadr flag)
- (if (string= "no" temp)
- (concat "-" (cadr flag))))))
+ (lambda (flag)
+ (setq temp
+ (widget-value (cadr (assoc (car flag) mairix-widgets))))
+ (if (string= "yes" temp)
+ (cadr flag)
+ (if (string= "no" temp)
+ (concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
@@ -694,34 +693,33 @@ Fill in VALUES if based on an article."
VALUES may contain values for editable fields from current article."
(let ((ret))
(mapc
- (function
- (lambda (field)
- (setq field (car (cddr field)))
- (setq
- ret
- (nconc
- (list
- (list
- (concat "c" field)
- (widget-create 'checkbox
- :tag field
- :notify (lambda (widget &rest ignore)
- (mairix-widget-toggle-activate widget))
- nil)))
- (list
- (list
- (concat "e" field)
- (widget-create 'editable-field
- :size 60
- :format (concat " " field ":"
- (make-string
- (- 11 (length field)) ?\ )
- "%v")
- :value (or (cadr (assoc field values)) ""))))
- ret))
- (widget-insert "\n")
- ;; Deactivate editable field
- (widget-apply (cadr (nth 1 ret)) :deactivate)))
+ (lambda (field)
+ (setq field (car (cddr field)))
+ (setq
+ ret
+ (nconc
+ (list
+ (list
+ (concat "c" field)
+ (widget-create 'checkbox
+ :tag field
+ :notify (lambda (widget &rest ignore)
+ (mairix-widget-toggle-activate widget))
+ nil)))
+ (list
+ (list
+ (concat "e" field)
+ (widget-create 'editable-field
+ :size 60
+ :format (concat " " field ":"
+ (make-string
+ (- 11 (length field)) ?\ )
+ "%v")
+ :value (or (cadr (assoc field values)) ""))))
+ ret))
+ (widget-insert "\n")
+ ;; Deactivate editable field
+ (widget-apply (cadr (nth 1 ret)) :deactivate))
mairix-widget-fields-list)
ret))
@@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous
search.\n\n")
(save-excursion
(save-restriction
(mapcar
- (function
- (lambda (field)
- (list (car (cddr field))
- (if (car field)
- (mairix-replace-invalid-chars
- (funcall get-mail-header (car field)))
- nil))))
+ (lambda (field)
+ (list (car (cddr field))
+ (if (car field)
+ (mairix-replace-invalid-chars
+ (funcall get-mail-header (car field)))
+ nil)))
mairix-widget-fields-list)))
(error "No function for obtaining mail header specified"))))
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index c5f4491..05e9747 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -43,8 +43,6 @@
(autoload 'sieve-manage "sieve")
(autoload 'sieve-upload "sieve")
-(eval-when-compile
- (require 'font-lock))
(defgroup sieve nil
"Sieve."
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 7cdb7eb..51cb316 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -363,7 +363,8 @@ ARGUMENTS to pass to the OPERATION."
;; by GNU Coreutils. Force "ls" to print one column and set
;; time-style to imitate other "ls" flavors.
((tramp-adb-send-command-and-check
- vec "ls --time-style=long-iso /dev/null")
+ vec (concat "ls --time-style=long-iso "
+ (tramp-get-remote-null-device vec)))
"ls -1 --time-style=long-iso")
;; Can't disable coloring explicitly for toybox ls command. We
;; also must force "ls" to print just one column.
@@ -371,7 +372,8 @@ ARGUMENTS to pass to the OPERATION."
;; On CyanogenMod based system BusyBox is used and "ls" output
;; coloring is enabled by default. So we try to disable it when
;; possible.
- ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
+ ((tramp-adb-send-command-and-check
+ vec (concat "ls --color=never -al " (tramp-get-remote-null-device vec)))
"ls --color=never")
(t "ls"))))
@@ -611,13 +613,13 @@ But handle the case, if the \"test\" command is not
available."
;; (introduced in POSIX.1-2008) fails.
(tramp-adb-send-command-and-check
v (format
- (concat "touch -d %s %s %s 2>/dev/null || "
- "touch -d %s %s %s 2>/dev/null || "
+ (concat "touch -d %s %s %s 2>%s || "
+ "touch -d %s %s %s 2>%s || "
"touch -t %s %s %s")
(format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
- nofollow quoted-name
+ nofollow quoted-name (tramp-get-remote-null-device v)
(format-time-string "%Y-%m-%dT%H:%M:%S" time t)
- nofollow quoted-name
+ nofollow quoted-name (tramp-get-remote-null-device v)
(format-time-string "%Y%m%d%H%M.%S" time t)
nofollow quoted-name)))))
@@ -791,7 +793,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(cons program args) " "))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -833,7 +835,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -1316,23 +1318,24 @@ connection if a previous connection has died for some
reason."
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
-;; Default settings for connection-local variables.
-(defconst tramp-adb-connection-local-default-profile
+;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+(defconst tramp-adb-connection-local-default-shell-variables
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote adb connections.")
+ "Default connection-local shell variables for remote adb connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-shell-profile
+ tramp-adb-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-adb-connection-local-default-profile
- tramp-adb-connection-local-default-profile)
- (tramp-compat-funcall
'connection-local-set-profiles
`(:application tramp :protocol ,tramp-adb-method)
- 'tramp-adb-connection-local-default-profile))
+ 'tramp-adb-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9a4e16e..7fae9ba 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -43,6 +43,7 @@
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
+(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
@@ -333,6 +334,13 @@ A nil value for either argument stands for the current
time."
(null (tramp-compat-directory-files
dir nil directory-files-no-dot-files-regexp t 1))))))
+;; Function `null-device' is new in Emacs 28.1.
+(defalias 'tramp-compat-null-device
+ (if (fboundp 'null-device)
+ #'null-device
+ (lambda ()
+ (if (tramp-tramp-file-p default-directory) "/dev/null" null-device))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 7e4a9bf..566c673 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'."
(info-lookup->topic-cache 'symbol))))))))
;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+
+(defconst tramp-connection-local-default-system-variables
+ '((path-separator . ":")
+ (null-device . "/dev/null"))
+ "Default connection-local system variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-system-profile
+ tramp-connection-local-default-system-variables)
+
+(tramp-compat-funcall
+ 'connection-local-set-profiles
+ `(:application tramp)
+ 'tramp-connection-local-default-system-profile)
-(defconst tramp-connection-local-default-profile
+(defconst tramp-connection-local-default-shell-variables
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote connections.")
+ "Default connection-local shell variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-shell-profile
+ tramp-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-connection-local-default-profile
- tramp-connection-local-default-profile)
- (tramp-compat-funcall
'connection-local-set-profiles
`(:application tramp)
- 'tramp-connection-local-default-profile))
+ 'tramp-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ccf0c0d..d2265ed 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -244,14 +244,14 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-methods
`("telnet"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
(add-to-list 'tramp-methods
`("nc"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -262,8 +262,7 @@ The string is used in `tramp-methods'.")
;; We use "-p" as required for newer busyboxes. For older
;; busybox/nc versions, the value must be (("-l") ("%r")).
This
;; can be achieved by tweaking `tramp-connection-properties'.
- (tramp-remote-copy-args (("-l") ("-p" "%r")
- ("2>/dev/null")))))
+ (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
(add-to-list 'tramp-methods
`("su"
(tramp-login-program "su")
@@ -763,7 +762,7 @@ This string is passed to `format', so percent characters
need to be doubled.")
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
+ "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
"Perl program to use for encoding a file.
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.
@@ -771,7 +770,7 @@ This implementation requires the MIME::Base64 Perl module
to be installed
on the remote host.")
(defconst tramp-perl-decode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
+ "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
"Perl program to use for decoding a file.
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.
@@ -812,7 +811,7 @@ while (read STDIN, $data, 54) {
(substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
$pad,
qq(\\n);
-}' 2>/dev/null"
+}' %n"
"Perl program to use for encoding a file.
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
@@ -856,7 +855,7 @@ while (my $data = <STDIN>) {
((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
last if $finished;
-}' 2>/dev/null"
+}' %n"
"Perl program to use for decoding a file.
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
@@ -938,7 +937,7 @@ BEGIN {
if (o) {
printf \"%%c\", o
} else {
- system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
+ system(\"dd if=/dev/zero bs=1 count=1 %n\")
}
obc=0; o=0
}
@@ -1785,7 +1784,7 @@ ID-FORMAT valid values are `string' and `integer'."
"cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
"xargs -0 %s -c "
"'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
+ "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with special
@@ -1801,6 +1800,7 @@ ID-FORMAT valid values are `string' and `integer'."
"%g"
(eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
tramp-stat-marker tramp-stat-marker
+ (tramp-get-remote-null-device vec)
tramp-stat-quoted-marker)))
;; This function should return "foo/" for directories and "bar" for
@@ -1827,14 +1827,16 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname)))
(format (concat
- "(cd %s 2>&1 && %s -a 2>/dev/null"
+ "(cd %s 2>&1 && %s -a 2>%s"
" | while IFS= read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
+ " if %s -d \"$f\" 2>%s;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
" && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
- (tramp-get-test-command v))))
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
@@ -2362,7 +2364,8 @@ The method used must be an out-of-band method."
options (format-spec (tramp-ssh-controlmaster-options v) spec)
spec (format-spec-make
?h host ?u user ?p port ?r listener ?c options
- ?k (if keep-date " " ""))
+ ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v)))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
@@ -2629,12 +2632,13 @@ The method used must be an out-of-band method."
(if full-directory-p
(tramp-send-command
v
- (format "%s %s %s 2>/dev/null"
+ (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if wildcard
localname
- (tramp-shell-quote-argument (concat localname ".")))))
+ (tramp-shell-quote-argument (concat localname ".")))
+ (tramp-get-remote-null-device v)))
(tramp-barf-unless-okay
v
(format "cd %s" (tramp-shell-quote-argument
@@ -2645,7 +2649,7 @@ The method used must be an out-of-band method."
(tramp-run-real-handler #'file-name-directory (list localname))))
(tramp-send-command
v
- (format "%s %s %s 2>/dev/null"
+ (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if (or wildcard
@@ -2655,7 +2659,8 @@ The method used must be an out-of-band method."
""
(tramp-shell-quote-argument
(tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))))
+ #'file-name-nondirectory (list localname))))
+ (tramp-get-remote-null-device v))))
(save-restriction
(let ((beg (point)))
@@ -2691,15 +2696,44 @@ The method used must be an out-of-band method."
;; Some busyboxes are reluctant to discard colors.
(unless
(string-match-p "color" (tramp-get-connection-property v "ls" ""))
- (goto-char beg)
- (while
- (re-search-forward tramp-display-escape-sequence-regexp nil t)
- (replace-match "")))
-
- ;; Decode the output, it could be multibyte.
- (decode-coding-region
- beg (point-max)
- (or file-name-coding-system default-file-name-coding-system))
+ (save-excursion
+ (goto-char beg)
+ (while
+ (re-search-forward tramp-display-escape-sequence-regexp nil t)
+ (replace-match ""))))
+
+ ;; Now decode what read if necessary. Stolen from
`insert-directory'.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region beg (point) t)))
+ (if (not (eq (coding-system-base coding) 'undecided))
+ (save-restriction
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (narrow-to-region beg (point))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so
+ ;; that CR is preserved.
+ (decode-coding-region pos (point)
+ (if val coding-no-eol coding))
+ (if val
+ (put-text-property pos (point)
+ 'dired-filename t)))))))
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
@@ -3117,7 +3151,7 @@ implementation will be used."
(mapconcat #'tramp-shell-quote-argument uenv " ") command)))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -3159,7 +3193,7 @@ implementation will be used."
tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -4088,7 +4122,10 @@ variable PATH."
(pipe-buf
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
- vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror)))
+ vec
+ (format "getconf PIPE_BUF / 2>%s || echo 4096"
+ (tramp-get-remote-null-device vec))
+ 'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
(if (< (length command) pipe-buf)
@@ -4410,7 +4447,12 @@ process to set up. VEC specifies the connection."
(tramp-find-shell vec)
;; Disable unexpected output.
- (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t)
+ (tramp-send-command
+ vec
+ (format "mesg n 2>%s; biff n 2>%s"
+ (tramp-get-remote-null-device vec)
+ (tramp-get-remote-null-device vec))
+ t)
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
@@ -4425,7 +4467,8 @@ process to set up. VEC specifies the connection."
;; Set utf8 encoding. Needed for macOS, for example. This is
;; non-POSIX, so we must expect errors on some systems.
- (tramp-send-command vec "stty iutf8 2>/dev/null" t)
+ (tramp-send-command
+ vec (concat "stty iutf8 2>" (tramp-get-remote-null-device vec)) t)
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""
'noerror)))
@@ -4541,7 +4584,8 @@ program will be transferred to the remote host, and it is
available as shell function with the same name. A \"%t\" format
specifier in the variable value denotes a temporary file.
\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
-respective `awk', `hexdump' and `od' commands.
+respective `awk', `hexdump' and `od' commands. \"%n\" is
+replaced by \"2>/dev/null\".
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@@ -4628,6 +4672,8 @@ Goes through the list `tramp-local-coding-commands' and
(format-spec-make
?a (tramp-get-remote-awk vec)
?h (tramp-get-remote-hexdump vec)
+ ?n (concat
+ "2>" (tramp-get-remote-null-device vec))
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(tramp-maybe-send-script vec value name)
@@ -4636,7 +4682,10 @@ Goes through the list `tramp-local-coding-commands' and
vec 5
"Checking remote encoding command `%s' for sanity" rem-enc)
(unless (tramp-send-command-and-check
- vec (format "%s </dev/null" rem-enc) t)
+ vec
+ (format
+ "%s <%s" rem-enc (tramp-get-remote-null-device
vec))
+ t)
(throw 'wont-work-remote nil))
(unless (stringp rem-dec)
@@ -4652,6 +4701,8 @@ Goes through the list `tramp-local-coding-commands' and
(format-spec-make
?a (tramp-get-remote-awk vec)
?h (tramp-get-remote-hexdump vec)
+ ?n (concat
+ "2>" (tramp-get-remote-null-device vec))
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(when (string-match-p "\\(^\\|[^%]\\)%t" value)
@@ -4698,7 +4749,7 @@ Goes through the list `tramp-local-coding-commands' and
"Call the local encoding or decoding command.
If CMD contains \"%s\", provide input file INPUT there in command.
Otherwise, INPUT is passed via standard input.
-INPUT can also be nil which means `/dev/null'.
+INPUT can also be nil which means `null-device'.
OUTPUT can be a string (which specifies a file name), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
@@ -5170,14 +5221,17 @@ status is 0, and nil otherwise.
If the optional argument SUBSHELL is non-nil, the command is
executed in a subshell, ie surrounded by parentheses. If
-DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null.
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-send-command
vec
(concat (if subshell "( " "")
command
- (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
+ (if command
+ (if dont-suppress-err
+ "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
+ "")
"echo tramp_exit_status $?"
(if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -5387,7 +5441,11 @@ Nonexistent directories are removed from spec."
(when elt1
(or
(tramp-send-command-and-read
- vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
+ vec
+ (format
+ "echo \\\"`getconf PATH 2>%s`\\\""
+ (tramp-get-remote-null-device vec))
+ 'noerror)
;; Default if "getconf" is not available.
(progn
(tramp-message
@@ -5491,7 +5549,8 @@ Nonexistent directories are removed from spec."
vec (format "%s -lnd /" result))
(when (tramp-send-command-and-check
vec (format
- "%s --color=never -al /dev/null" result))
+ "%s --color=never -al %s"
+ result (tramp-get-remote-null-device vec)))
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
@@ -5512,7 +5571,9 @@ Nonexistent directories are removed from spec."
(format
"%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec))))
(tramp-send-command-and-check
- vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option))
+ vec (format
+ "%s %s -al %s"
+ (tramp-get-ls-command vec) option (tramp-get-remote-null-device
vec)))
option)))
(defun tramp-get-test-command (vec)
@@ -5791,7 +5852,7 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(command (format "%s %s" busybox "awk")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " {} </dev/null"))
+ vec (concat command " {} <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-hexdump (vec)
@@ -5802,7 +5863,8 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "hexdump")))
(and busybox
- (tramp-send-command-and-check vec (concat command " </dev/null"))
+ (tramp-send-command-and-check
+ vec (concat command " <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-od (vec)
@@ -5814,7 +5876,8 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(command (format "%s %s" busybox "od")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " -A n </dev/null"))
+ vec
+ (concat command " -A n <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-chmod-h (vec)
@@ -5836,7 +5899,9 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Checking, whether `env -u' works")
;; Option "-u" is a GNU extension.
(tramp-send-command-and-check
- vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t)))
+ vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
+ (tramp-get-remote-null-device vec))
+ t)))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 8a48ffc..cafa97c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -74,7 +74,7 @@
:version "24.4")
;;;###tramp-autoload
-(defcustom tramp-smb-conf "/dev/null"
+(defcustom tramp-smb-conf null-device
"Path of the \"smb.conf\" file.
If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
@@ -797,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
- "2>/dev/null")))
+ (concat "2>" (tramp-get-remote-null-device
v)))))
(unwind-protect
(with-temp-buffer
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a98d478..d40f9a5 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -238,6 +238,7 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
- \"%k\" indicates the keep-date parameter of a program, if exists.
- \"%c\" adds additional `tramp-ssh-controlmaster-options'
options for the first hop.
+ - \"%n\" expands to \"2>/dev/null\".
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -5325,7 +5326,9 @@ name of a process or buffer, or nil to default to the
current buffer."
(tramp-compat-funcall
'tramp-send-command
(process-get proc 'vector)
- (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid))
+ (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
+ pid pid
+ (tramp-get-remote-null-device (process-get proc 'vector))))
;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0))
@@ -5339,6 +5342,15 @@ name of a process or buffer, or nil to default to the
current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+(defun tramp-get-remote-null-device (vec)
+ "Return null device on the remote host identified by VEC.
+If VEC is nil, return local null device."
+ (if (null vec)
+ null-device
+ (with-tramp-connection-property vec "null-device"
+ (let ((default-directory (tramp-make-tramp-file-name vec)))
+ (tramp-compat-null-device)))))
+
(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
"Skeleton for `tramp-*-handle-delete-directory'.
BODY is the backend specific code."
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index e111ae8..3eb158d 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1292,7 +1292,15 @@ changed with `comment-style'."
(defun comment-region-default (beg end &optional arg)
(if comment-combine-change-calls
- (combine-change-calls beg end (comment-region-default-1 beg end arg))
+ (combine-change-calls beg
+ ;; A new line might get inserted and whitespace deleted
+ ;; after END for line comments. Ensure the next argument is
+ ;; after any and all changes.
+ (save-excursion
+ (goto-char end)
+ (forward-line)
+ (point))
+ (comment-region-default-1 beg end arg))
(comment-region-default-1 beg end arg)))
;;;###autoload
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 1ab8ab6..d2a36dd 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -18535,8 +18535,7 @@ an argument, unconditionally call `org-insert-heading'."
("Customize"
["Browse Org Group" org-customize t]
"--"
- ["Expand This Menu" org-create-customize-menu
- (fboundp 'customize-menu-create)])
+ ["Expand This Menu" org-create-customize-menu t])
["Send bug report" org-submit-bug-report t]
"--"
("Refresh/Reload"
@@ -18709,20 +18708,17 @@ With prefix arg UNCOMPILED, load the uncompiled
versions."
(interactive)
(org-load-modules-maybe)
(org-require-autoloaded-modules)
- (if (fboundp 'customize-menu-create)
- (progn
- (easy-menu-change
- '("Org") "Customize"
- `(["Browse Org group" org-customize t]
- "--"
- ,(customize-menu-create 'org)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]))
- (message "\"Org\"-menu now contains full customization menu"))
- (error "Cannot expand menu (outdated version of cus-edit.el)")))
+ (easy-menu-change
+ '("Org") "Customize"
+ `(["Browse Org group" org-customize t]
+ "--"
+ ,(customize-menu-create 'org)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"Org\"-menu now contains full customization menu"))
;;;; Miscellaneous stuff
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 2443f37..375d06c 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -103,9 +103,7 @@ that a password is invalid, so that `password-read' query
the
user again."
(let ((password (gethash key password-data)))
(when (stringp password)
- (if (fboundp 'clear-string)
- (clear-string password)
- (fillarray password ?_)))
+ (clear-string password))
(remhash key password-data)))
(defun password-cache-add (key password)
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index fa84b31..c605009 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -65,15 +65,14 @@
"Find all zipped or unzipped files: the inverse of UNZIP-P."
(pcomplete-entries
nil
- (function
- (lambda (entry)
- (or (file-directory-p entry)
- (when (and (file-readable-p entry)
- (file-regular-p entry))
- (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
- entry)))
- (or (and unzip-p zipped)
- (and (not unzip-p) (not zipped))))))))))
+ (lambda (entry)
+ (or (file-directory-p entry)
+ (when (and (file-readable-p entry)
+ (file-regular-p entry))
+ (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
+ entry)))
+ (or (and unzip-p zipped)
+ (and (not unzip-p) (not zipped)))))))))
;;;###autoload
(defun pcomplete/bzip2 ()
@@ -92,13 +91,12 @@
"Find all zipped or unzipped files: the inverse of UNZIP-P."
(pcomplete-entries
nil
- (function
- (lambda (entry)
- (when (and (file-readable-p entry)
- (file-regular-p entry))
- (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
- (or (and unzip-p zipped)
- (and (not unzip-p) (not zipped)))))))))
+ (lambda (entry)
+ (when (and (file-readable-p entry)
+ (file-regular-p entry))
+ (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
+ (or (and unzip-p zipped)
+ (and (not unzip-p) (not zipped))))))))
;;;###autoload
(defun pcomplete/make ()
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 1cf690a..06ea54c 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -233,7 +233,7 @@ Variables: `handwrite-linespace' (default 12)
))
(switch-to-buffer ps-buf-name)
(forward-line 1)
- (insert "showpage exec Hwsave restore\n\n")
+ (insert " showpage exec Hwsave restore\n\n")
(insert "%%Pages " (number-to-string ipage) " 0\n")
(insert "%%EOF\n")
;;To avoid cumbersome code we simply ignore formfeeds
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 7e36e1f..9a044fc 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3684,7 +3684,7 @@ When \"(\" is present, that defun will attempt to parse a
parenthesized expression inside the template. When \")\" is
present it will treat an unbalanced closing paren as a sign of
the invalidity of the putative template construct."
- t "[<;{},|+&->)]"
+ t "[<;{},|+&>)-]"
c++ "[<;{},>()]")
(c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index e0dabed..de9c9a2 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -334,48 +334,44 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1)
(gnu
- ;; The first line matches the program name for
-
- ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
-
- ;; format, which is used for non-interactive programs other than
- ;; compilers (e.g. the "jade:" entry in compilation.txt).
-
- ;; This first line makes things ambiguous with output such as
- ;; "foo:344:50:blabla" since the "foo" part can match this first
- ;; line (in which case the file name as "344"). To avoid this,
- ;; the second line disallows filenames exclusively composed of
- ;; digits.
-
- ;; Similarly, we get lots of false positives with messages including
- ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
- ;; the last line tries to rule out message where the info after the
- ;; line number starts with "SS". --Stef
-
- ;; The core of the regexp is the one with *?. It says that a file name
- ;; can be composed of any non-newline char, but it also rules out some
- ;; valid but unlikely cases, such as a trailing space or a space
- ;; followed by a -, or a colon followed by a space.
- ;;
- ;; The "in \\|from " exception was added to handle messages from Ruby.
,(rx
bol
+ ;; Match an optional program name in the format
+ ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
+ ;; which is used for non-interactive programs other than
+ ;; compilers (e.g. the "jade:" entry in compilation.txt).
(? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ ;; FIXME: This pattern was added for handling messages
+ ;; from Ruby, but it is unclear whether it is actually
+ ;; used since the gcc-include rule above seems to cover
+ ;; it.
(regexp "[ \t]+\\(?:in \\|from\\)")))
- (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
- (*? (| (regexp "[^\n :]")
- (regexp " [^-/\n]")
- (regexp ":[^ \n]")))))
+
+ ;; File name group.
+ (group-n 1
+ ;; Avoid matching the file name as a program in the pattern
+ ;; above by disallow file names entirely composed of digits.
+ (: (regexp "[0-9]*[^0-9\n]")
+ ;; This rule says that a file name can be composed
+ ;; of any non-newline char, but it also rules out
+ ;; some valid but unlikely cases, such as a
+ ;; trailing space or a space followed by a -, or a
+ ;; colon followed by a space.
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
(regexp ": ?")
+
+ ;; Line number group.
(group-n 2 (regexp "[0-9]+"))
(? (| (: "-"
- (group-n 4 (regexp "[0-9]+"))
- (? "." (group-n 5 (regexp "[0-9]+"))))
+ (group-n 4 (regexp "[0-9]+")) ; ending line
+ (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column
(: (in ".:")
- (group-n 3 (regexp "[0-9]+"))
+ (group-n 3 (regexp "[0-9]+")) ; starting column
(? "-"
- (? (group-n 4 (regexp "[0-9]+")) ".")
- (group-n 5 (regexp "[0-9]+"))))))
+ (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line
+ (group-n 5 (regexp "[0-9]+")))))) ; ending column
":"
(| (: (* " ")
(group-n 6 (| "FutureWarning"
@@ -392,6 +388,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(regexp "[Nn]ote"))))
(: (* " ")
(regexp "[Ee]rror"))
+
+ ;; Avoid matching time stamps on the form "HH:MM:SS" where
+ ;; MM is interpreted as a line number by trying to rule out
+ ;; messages where the text after the line number starts with
+ ;; a 2-digit number.
(: (regexp "[0-9]?")
(| (regexp "[^0-9\n]")
eol))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index a42ace1..30a80ea 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -54,8 +54,6 @@
;; of other details.
;; The mode information (on C-h m) provides some customization help.
-;; If you use font-lock feature of this mode, it is advisable to use
-;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock.
;; Faces used now: three faces for first-class and second-class keywords
;; and control flow words, one for each: comments, string, labels,
@@ -402,7 +400,7 @@ Font for POD headers."
:version "21.1"
:group 'cperl-faces)
-(defcustom cperl-pod-here-fontify '(featurep 'font-lock)
+(defcustom cperl-pod-here-fontify t
"Not-nil after evaluation means to highlight POD and here-docs sections."
:type 'boolean
:group 'cperl-faces)
@@ -3959,7 +3957,7 @@ the sections using `cperl-pod-head-face',
`cperl-pod-face',
(not (memq (preceding-char)
'(?$ ?@ ?& ?%)))
(looking-at
-
"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>")))))
+
"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))))
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
@@ -5442,11 +5440,10 @@ indentation and initial hashes. Behaves usually
outside of comment."
(cperl-init-faces))))
((not cperl-faces-init)
(add-hook 'font-lock-mode-hook
- (function
- (lambda ()
- (if (memq major-mode '(perl-mode cperl-mode))
- (progn
- (or cperl-faces-init (cperl-init-faces)))))))
+ (lambda ()
+ (if (memq major-mode '(perl-mode cperl-mode))
+ (progn
+ (or cperl-faces-init (cperl-init-faces))))))
(eval-after-load
"ps-print"
'(or cperl-faces-init (cperl-init-faces))))))
@@ -6073,9 +6070,8 @@ side-effect of memorizing only. Examples in
`cperl-style-examples'."
(list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
(or cperl-old-style
(setq cperl-old-style
- (mapcar (function
- (lambda (name)
- (cons name (eval name))))
+ (mapcar (lambda (name)
+ (cons name (eval name)))
cperl-styles-entries)))
(let ((style (cdr (assoc style cperl-style-alist))) setting)
(while style
@@ -6527,22 +6523,21 @@ Does not move point."
(setq lst (cdr (assoc "+Unsorted List+..." ind))))
(setq lst
(mapcar
- (function
- (lambda (elt)
- (cond ((string-match "^[_a-zA-Z]" (car elt))
- (goto-char (cdr elt))
- (beginning-of-line) ; pos should be of the start of
the line
- (list (car elt)
- (point)
- (1+ (count-lines 1 (point))) ; 1+ since at
beg-o-l
- (buffer-substring (progn
- (goto-char (cdr elt))
- ;; After name now...
- (or (eolp) (forward-char 1))
- (point))
- (progn
- (beginning-of-line)
- (point))))))))
+ (lambda (elt)
+ (cond ((string-match "^[_a-zA-Z]" (car elt))
+ (goto-char (cdr elt))
+ (beginning-of-line) ; pos should be of the start of
the line
+ (list (car elt)
+ (point)
+ (1+ (count-lines 1 (point))) ; 1+ since at
beg-o-l
+ (buffer-substring (progn
+ (goto-char (cdr elt))
+ ;; After name now...
+ (or (eolp) (forward-char 1))
+ (point))
+ (progn
+ (beginning-of-line)
+ (point)))))))
lst))
(erase-buffer)
(while lst
@@ -6607,6 +6602,9 @@ Use as
"
(cperl-write-tags nil nil t t))
+(defvar cperl-tags-file-name "TAGS"
+ "TAGS file name to use in `cperl-write-tags'.")
+
(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
;; If INBUFFER, do not select buffer, and do not save
;; If ERASE is `ignore', do not erase, and do not try to delete old info.
@@ -6616,7 +6614,7 @@ Use as
(if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
(or topdir
(setq topdir default-directory))
- (let ((tags-file-name "TAGS")
+ (let ((tags-file-name cperl-tags-file-name)
(inhibit-read-only t)
(case-fold-search nil)
xs rel)
@@ -6645,16 +6643,15 @@ Use as
(setq cperl-unreadable-ok t)
nil) ; Return empty list
(error "Aborting: unreadable directory %s" file)))))))
- (mapc (function
- (lambda (file)
- (cond
- ((string-match cperl-noscan-files-regexp file)
- nil)
- ((not (file-directory-p file))
- (if (string-match cperl-scan-files-regexp file)
- (cperl-write-tags file erase recurse nil t noxs
topdir)))
- ((not recurse) nil)
- (t (cperl-write-tags file erase recurse t t noxs topdir)))))
+ (mapc (lambda (file)
+ (cond
+ ((string-match cperl-noscan-files-regexp file)
+ nil)
+ ((not (file-directory-p file))
+ (if (string-match cperl-scan-files-regexp file)
+ (cperl-write-tags file erase recurse nil t noxs
topdir)))
+ ((not recurse) nil)
+ (t (cperl-write-tags file erase recurse t t noxs topdir))))
files)))
(t
(setq xs (string-match "\\.xs$" file))
@@ -6768,11 +6765,10 @@ One may build such TAGS files from CPerl mode menu."
(or tags-table-list
(call-interactively 'visit-tags-table))
(mapc
- (function
- (lambda (tagsfile)
- (message "Updating list of classes... %s" tagsfile)
- (set-buffer (get-file-buffer tagsfile))
- (cperl-tags-hier-fill)))
+ (lambda (tagsfile)
+ (message "Updating list of classes... %s" tagsfile)
+ (set-buffer (get-file-buffer tagsfile))
+ (cperl-tags-hier-fill))
tags-table-list)
(message "Updating list of classes... postprocessing...")
(mapc remover (car cperl-hierarchy))
@@ -6816,24 +6812,23 @@ One may build such TAGS files from CPerl mode menu."
l1 head cons1 cons2 ord writeto recurse
root-packages root-functions
(move-deeper
- (function
- (lambda (elt)
- (cond ((and (string-match regexp (car elt))
- (or (eq ord 1) (match-end 2)))
- (setq head (substring (car elt) 0 (match-end 1))
- recurse t)
- (if (setq cons1 (assoc head writeto)) nil
- ;; Need to init new head
- (setcdr writeto (cons (list head (list "Packages: ")
- (list "Methods: "))
- (cdr writeto)))
- (setq cons1 (nth 1 writeto)))
- (setq cons2 (nth ord cons1)) ; Either packs or meths
- (setcdr cons2 (cons elt (cdr cons2))))
- ((eq ord 2)
- (setq root-functions (cons elt root-functions)))
- (t
- (setq root-packages (cons elt root-packages))))))))
+ (lambda (elt)
+ (cond ((and (string-match regexp (car elt))
+ (or (eq ord 1) (match-end 2)))
+ (setq head (substring (car elt) 0 (match-end 1))
+ recurse t)
+ (if (setq cons1 (assoc head writeto)) nil
+ ;; Need to init new head
+ (setcdr writeto (cons (list head (list "Packages: ")
+ (list "Methods: "))
+ (cdr writeto)))
+ (setq cons1 (nth 1 writeto)))
+ (setq cons2 (nth ord cons1)) ; Either packs or meths
+ (setcdr cons2 (cons elt (cdr cons2))))
+ ((eq ord 2)
+ (setq root-functions (cons elt root-functions)))
+ (t
+ (setq root-packages (cons elt root-packages)))))))
(setcdr to l1) ; Init to dynamic space
(setq writeto to)
(setq ord 1)
@@ -6903,16 +6898,15 @@ One may build such TAGS files from CPerl mode menu."
(let (list)
(cons 'keymap
(mapcar
- (function
- (lambda (elt)
- (cond ((listp (cdr elt))
- (setq list (cperl-list-fold
- (cdr elt) (car elt) imenu-max-items))
- (cons nil
- (cons (car elt)
- (cperl-menu-to-keymap list))))
- (t
- (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
+ (lambda (elt)
+ (cond ((listp (cdr elt))
+ (setq list (cperl-list-fold
+ (cdr elt) (car elt) imenu-max-items))
+ (cons nil
+ (cons (car elt)
+ (cperl-menu-to-keymap list))))
+ (t
+ (list (cdr elt) (car elt) t)))) ; t is needed in 19.34
(cperl-list-fold menu "Root" imenu-max-items)))))
@@ -8239,15 +8233,14 @@ If a region is highlighted, restricts to the region."
end (max (mark) (point)))
(setq beg (point-min)
end (point-max)))
- (cperl-map-pods-heres (function
- (lambda (s e _p)
- (if do-heres
- (setq e (save-excursion
- (goto-char e)
- (forward-line -1)
- (point))))
- (ispell-region s e)
- t))
+ (cperl-map-pods-heres (lambda (s e _p)
+ (if do-heres
+ (setq e (save-excursion
+ (goto-char e)
+ (forward-line -1)
+ (point))))
+ (ispell-region s e)
+ t)
(if do-heres 'here-doc-group 'in-pod)
beg end))))
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 6e9b683..9030056 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -373,19 +373,17 @@ were not yet received."
(dolist (handler gdb-handler-list)
(setf (gdb-handler-pending-trigger handler) nil)))
-(defmacro gdb-wait-for-pending (&rest body)
- "Wait for all pending GDB commands to finish and evaluate BODY.
+(defun gdb-wait-for-pending (func)
+ "Wait for all pending GDB commands to finish and call FUNC.
This function checks every 0.5 seconds if there are any pending
triggers in `gdb-handler-list'."
- `(run-with-timer
- 0.5 nil
- '(lambda ()
- (if (not (cl-find-if (lambda (handler)
- (gdb-handler-pending-trigger handler))
- gdb-handler-list))
- (progn ,@body)
- (gdb-wait-for-pending ,@body)))))
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (if (cl-some #'gdb-handler-pending-trigger gdb-handler-list)
+ (gdb-wait-for-pending func)
+ (funcall func)))))
;; Publish-subscribe
@@ -1617,17 +1615,16 @@ this trigger is subscribed to `gdb-buf-publisher' and
called with
;; (if it has an associated update trigger)
(add-hook
'kill-buffer-hook
- (function
- (lambda ()
- (let ((trigger (gdb-rules-update-trigger
- (gdb-current-buffer-rules))))
- (when trigger
- (gdb-delete-subscriber
- gdb-buf-publisher
- ;; This should match gdb-add-subscriber done in
- ;; gdb-get-buffer-create
- (cons (current-buffer)
- (gdb-bind-function-to-buffer trigger (current-buffer))))))))
+ (lambda ()
+ (let ((trigger (gdb-rules-update-trigger
+ (gdb-current-buffer-rules))))
+ (when trigger
+ (gdb-delete-subscriber
+ gdb-buf-publisher
+ ;; This should match gdb-add-subscriber done in
+ ;; gdb-get-buffer-create
+ (cons (current-buffer)
+ (gdb-bind-function-to-buffer trigger (current-buffer)))))))
nil t))
;; Partial-output buffer : This accumulates output from a command executed on
@@ -2525,7 +2522,7 @@ Unset `gdb-thread-number' if current thread exited and
update threads list."
;; disallow us to properly call -thread-info without --thread option.
;; Thus we need to use gdb-wait-for-pending.
(gdb-wait-for-pending
- (gdb-emit-signal gdb-buf-publisher 'update-threads))))
+ (lambda () (gdb-emit-signal gdb-buf-publisher 'update-threads)))))
(defun gdb-thread-selected (_token output-field)
"Handler for =thread-selected MI output record.
@@ -2539,11 +2536,10 @@ Sets `gdb-thread-number' to new id."
;; as usually. Things happen too fast and second call (from
;; gdb-thread-selected handler) gets cut off by our beloved
;; pending triggers.
- ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
- ;; body will get executed when `gdb-handler-list' if free of
+ ;; Solution is `gdb-wait-for-pending': it guarantees that its
+ ;; argument will get called when `gdb-handler-list' if free of
;; pending triggers.
- (gdb-wait-for-pending
- (gdb-update))))
+ (gdb-wait-for-pending #'gdb-update)))
(defun gdb-running (_token output-field)
(let* ((thread-id
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 9683826..dafba22 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -296,8 +296,10 @@ See `compilation-error-screen-columns'."
:help "Kill the currently running grep process"))
(define-key map [menu-bar grep compilation-separator2] '("----"))
(define-key map [menu-bar grep compilation-compile]
- '(menu-item "Compile..." compile
- :help "Compile the program including the current buffer.
Default: run `make'"))
+ '(menu-item
+ "Compile..." compile
+ :help
+ "Compile the program including the current buffer. Default: run
`make'"))
(define-key map [menu-bar grep compilation-rgrep]
'(menu-item "Recursive grep..." rgrep
:help "User-friendly recursive grep in directory tree"))
@@ -308,15 +310,18 @@ See `compilation-error-screen-columns'."
'(menu-item "Grep via Find..." grep-find
:help "Run grep via find, with user-specified args"))
(define-key map [menu-bar grep compilation-grep]
- '(menu-item "Another grep..." grep
- :help "Run grep, with user-specified args, and collect output
in a buffer."))
+ '(menu-item
+ "Another grep..." grep
+ :help
+ "Run grep, with user-specified args, and collect output in a buffer."))
(define-key map [menu-bar grep compilation-recompile]
'(menu-item "Repeat grep" recompile
:help "Run grep again"))
(define-key map [menu-bar grep compilation-separator1] '("----"))
(define-key map [menu-bar grep compilation-first-error]
- '(menu-item "First Match" first-error
- :help "Restart at the first match, visit corresponding
location"))
+ '(menu-item
+ "First Match" first-error
+ :help "Restart at the first match, visit corresponding location"))
(define-key map [menu-bar grep compilation-previous-error]
'(menu-item "Previous Match" previous-error
:help "Visit the previous match and corresponding location"))
@@ -389,7 +394,8 @@ Notice that using \\[next-error] or \\[compile-goto-error]
modifies
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face
grep-match-face)))
+ (mbeg
+ (text-property-any beg end 'font-lock-face
grep-match-face)))
(when mbeg
(- mbeg beg)))))
.
@@ -397,8 +403,11 @@ Notice that using \\[next-error] or \\[compile-goto-error]
modifies
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face
grep-match-face))
- (mend (and mbeg (next-single-property-change mbeg
'font-lock-face nil end))))
+ (mbeg
+ (text-property-any beg end 'font-lock-face grep-match-face))
+ (mend
+ (and mbeg (next-single-property-change
+ mbeg 'font-lock-face nil end))))
(when mend
(- mend beg))))))
nil nil
@@ -614,6 +623,15 @@ This function is called from `compilation-filter-hook'."
(error nil))
(or result 0))))
+(defun grep-hello-file ()
+ (let ((result
+ (if (file-remote-p default-directory)
+ (make-temp-file (file-name-as-directory
(temporary-file-directory)))
+ (expand-file-name "HELLO" data-directory))))
+ (when (file-remote-p result)
+ (write-region "Copyright\n" nil result))
+ result))
+
;;;###autoload
(defun grep-compute-defaults ()
"Compute the defaults for the `grep' command.
@@ -655,37 +673,46 @@ The value depends on `grep-command', `grep-template',
(unless (or (not grep-use-null-device) (eq grep-use-null-device t))
(setq grep-use-null-device
(with-temp-buffer
- (let ((hello-file (expand-file-name "HELLO" data-directory)))
- (not
- (and (if grep-command
- ;; `grep-command' is already set, so
- ;; use that for testing.
- (grep-probe grep-command
- `(nil t nil "^Copyright" ,hello-file)
- #'call-process-shell-command)
- ;; otherwise use `grep-program'
- (grep-probe grep-program
- `(nil t nil "-nH" "^Copyright"
,hello-file)))
- (progn
- (goto-char (point-min))
- (looking-at
- (concat (regexp-quote hello-file)
- ":[0-9]+:Copyright")))))))))
+ (let ((hello-file (grep-hello-file)))
+ (prog1
+ (not
+ (and (if grep-command
+ ;; `grep-command' is already set, so
+ ;; use that for testing.
+ (grep-probe
+ grep-command
+ `(nil t nil "^Copyright"
+ ,(file-local-name hello-file))
+ #'process-file-shell-command)
+ ;; otherwise use `grep-program'
+ (grep-probe
+ grep-program
+ `(nil t nil "-nH" "^Copyright"
+ ,(file-local-name hello-file))))
+ (progn
+ (goto-char (point-min))
+ (looking-at
+ (concat (regexp-quote (file-local-name hello-file))
+ ":[0-9]+:Copyright")))))
+ (when (file-remote-p hello-file) (delete-file
hello-file)))))))
(when (eq grep-use-null-filename-separator 'auto-detect)
(setq grep-use-null-filename-separator
(with-temp-buffer
- (let* ((hello-file (expand-file-name "HELLO" data-directory))
- (args `("--null" "-ne" "^Copyright" ,hello-file)))
+ (let* ((hello-file (grep-hello-file))
+ (args `("--null" "-ne" "^Copyright"
+ ,(file-local-name hello-file))))
(if grep-use-null-device
- (setq args (append args (list null-device)))
+ (setq args (append args (list (null-device))))
(push "-H" args))
- (and (grep-probe grep-program `(nil t nil ,@args))
- (progn
- (goto-char (point-min))
- (looking-at
- (concat (regexp-quote hello-file)
- "\0[0-9]+:Copyright"))))))))
+ (prog1
+ (and (grep-probe grep-program `(nil t nil ,@args))
+ (progn
+ (goto-char (point-min))
+ (looking-at
+ (concat (regexp-quote (file-local-name hello-file))
+ "\0[0-9]+:Copyright"))))
+ (when (file-remote-p hello-file) (delete-file
hello-file)))))))
(when (eq grep-highlight-matches 'auto-detect)
(setq grep-highlight-matches
@@ -704,7 +731,7 @@ The value depends on `grep-command', `grep-template',
(concat (if grep-use-null-device "-n" "-nH")
(if grep-use-null-filename-separator " --null")
(when (grep-probe grep-program
- `(nil nil nil "-e" "foo" ,null-device)
+ `(nil nil nil "-e" "foo" ,(null-device))
nil 1)
" -e"))))
(unless grep-command
@@ -712,13 +739,14 @@ The value depends on `grep-command', `grep-template',
(format "%s %s %s " grep-program
(or
(and grep-highlight-matches
- (grep-probe grep-program
- `(nil nil nil "--color" "x"
,null-device)
- nil 1)
+ (grep-probe
+ grep-program
+ `(nil nil nil "--color" "x" ,(null-device))
+ nil 1)
(if (eq grep-highlight-matches 'always)
"--color=always" "--color"))
"")
- grep-options)))
+ grep-options)))
(unless grep-template
(setq grep-template
(format "%s <X> <C> %s <R> <F>" grep-program grep-options)))
@@ -726,11 +754,12 @@ The value depends on `grep-command', `grep-template',
(setq grep-find-use-xargs
(cond
((grep-probe find-program
- `(nil nil nil ,null-device "-exec" "echo"
+ `(nil nil nil ,(null-device) "-exec" "echo"
"{}" "+"))
'exec-plus)
((and
- (grep-probe find-program `(nil nil nil ,null-device
"-print0"))
+ (grep-probe
+ find-program `(nil nil nil ,(null-device) "-print0"))
(grep-probe xargs-program '(nil nil nil "-0" "echo")))
'gnu)
(t
@@ -750,12 +779,13 @@ The value depends on `grep-command', `grep-template',
(let ((cmd0 (format "%s . -type f -exec %s"
find-program grep-command))
(null (if grep-use-null-device
- (format "%s " null-device)
+ (format "%s " (null-device))
"")))
(cons
(if (eq grep-find-use-xargs 'exec-plus)
(format "%s %s%s +" cmd0 null quot-braces)
- (format "%s %s %s%s" cmd0 quot-braces null
quot-scolon))
+ (format "%s %s %s%s"
+ cmd0 quot-braces null quot-scolon))
(1+ (length cmd0)))))
(t
(format "%s . -type f -print | \"%s\" %s"
@@ -765,7 +795,7 @@ The value depends on `grep-command', `grep-template',
(let ((gcmd (format "%s <C> %s <R>"
grep-program grep-options))
(null (if grep-use-null-device
- (format "%s " null-device)
+ (format "%s " (null-device))
"")))
(cond ((eq grep-find-use-xargs 'gnu)
(format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
@@ -814,7 +844,8 @@ The value depends on `grep-command', `grep-template',
(let ((tag-default (shell-quote-argument (grep-tag-default)))
;; This a regexp to match single shell arguments.
;; Could someone please add comments explaining it?
- (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"'
\t\n]\\)+\\)")
+ (sh-arg-re
+ "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
(grep-default (or (car grep-history) grep-command)))
;; In the default command, find the arg that specifies the pattern.
(when (or (string-match
@@ -909,8 +940,8 @@ list is empty)."
(grep--save-buffers)
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
- (compilation-start (if (and grep-use-null-device null-device)
- (concat command-args " " null-device)
+ (compilation-start (if (and grep-use-null-device null-device (null-device))
+ (concat command-args " " (null-device))
command-args)
#'grep-mode))
@@ -948,7 +979,7 @@ easily repeat a find command."
'(("<C>" . (mapconcat #'identity opts " "))
("<D>" . (or dir "."))
("<F>" . files)
- ("<N>" . null-device)
+ ("<N>" . (null-device))
("<X>" . excl)
("<R>" . (shell-quote-argument (or regexp ""))))
"List of substitutions performed by `grep-expand-template'.
@@ -1052,8 +1083,9 @@ REGEXP is used as a string in the prompt."
#'read-file-name-internal
nil nil nil 'grep-files-history
(delete-dups
- (delq nil (append (list default default-alias
default-extension)
- (mapcar #'car grep-files-aliases)))))))
+ (delq nil
+ (append (list default default-alias default-extension)
+ (mapcar #'car grep-files-aliases)))))))
(and files
(or (cdr (assoc files grep-files-aliases))
files))))
@@ -1105,11 +1137,12 @@ command before it's run."
(if (string= command grep-command)
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
- (unless (or (not grep-use-directories-skip) (eq
grep-use-directories-skip t))
+ (unless (or (not grep-use-directories-skip)
+ (eq grep-use-directories-skip t))
(setq grep-use-directories-skip
(grep-probe grep-program
`(nil nil nil "--directories=skip" "foo"
- ,null-device)
+ ,(null-device))
nil 1)))
(setq command (grep-expand-template
grep-template
@@ -1141,10 +1174,11 @@ command before it's run."
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
(grep--save-buffers)
- (compilation-start (if (and grep-use-null-device null-device)
- (concat command " " null-device)
- command)
- 'grep-mode))
+ (compilation-start
+ (if (and grep-use-null-device null-device (null-device))
+ (concat command " " (null-device))
+ command)
+ 'grep-mode))
;; Set default-directory if we started lgrep in the *grep* buffer.
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 2d4ea46..89296ff 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1173,17 +1173,16 @@ When DING is non-nil, ring the bell as well."
Useful when source code is displayed as help. See the option
`idlwave-help-fontify-source-code'."
(interactive)
- (if (featurep 'font-lock)
- (let ((major-mode 'idlwave-mode)
- (font-lock-verbose
- (if (called-interactively-p 'interactive) font-lock-verbose nil)))
- (with-syntax-table idlwave-mode-syntax-table
- (set (make-local-variable 'font-lock-defaults)
- idlwave-font-lock-defaults)
- (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
- (font-lock-ensure)
- ;; Silence "interactive use only" warning on Emacs >= 25.1.
- (with-no-warnings (font-lock-fontify-buffer)))))))
+ (let ((major-mode 'idlwave-mode)
+ (font-lock-verbose
+ (if (called-interactively-p 'interactive) font-lock-verbose nil)))
+ (with-syntax-table idlwave-mode-syntax-table
+ (set (make-local-variable 'font-lock-defaults)
+ idlwave-font-lock-defaults)
+ (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
+ (font-lock-ensure)
+ ;; Silence "interactive use only" warning on Emacs >= 25.1.
+ (with-no-warnings (font-lock-fontify-buffer))))))
(defun idlwave-help-error (name type class keyword)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 38127fc..70b9459 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -26,8 +26,7 @@
;;; Commentary:
;;
-;; This mode is for IDL version 5 or later. It should work on
-;; Emacs>20.3 or XEmacs>20.4.
+;; This mode is for IDL version 5 or later.
;;
;; Runs IDL as an inferior process of Emacs, much like the Emacs
;; `shell' or `telnet' commands. Provides command history and
@@ -68,15 +67,6 @@
;; maintainers webpage (see under SOURCE)
;;
;;
-;; KNOWN PROBLEMS
-;; ==============
-;;
-;; Under XEmacs the Debug menu in the shell does not display the
-;; keybindings in the prefix map. There bindings are available anyway - so
-;; it is a bug in XEmacs.
-;; The Debug menu in source buffers *does* display the bindings correctly.
-;;
-;;
;; CUSTOMIZATION VARIABLES
;; =======================
;;
@@ -166,7 +156,6 @@ t Arrows force the cursor back to the current
command line and
"Non-nil means, use the debugging toolbar in all IDL related buffers.
Starting the shell will then add the toolbar to all idlwave-mode buffers.
Exiting the shell will removed everywhere.
-Available on XEmacs and on Emacs 21.x or later.
At any time you can toggle the display of the toolbar with
`C-c C-d C-t' (`idlwave-shell-toggle-toolbar')."
:group 'idlwave-shell-general-setup
@@ -606,12 +595,6 @@ the directory stack.")
(defvar idlwave-shell-last-save-and-action-file nil
"The last file which was compiled with `idlwave-shell-save-and-...'.")
-;; Highlighting uses overlays. When necessary, require the emulation.
-(if (not (fboundp 'make-overlay))
- (condition-case nil
- (require 'overlay)
- (error nil)))
-
(defvar idlwave-shell-stop-line-overlay nil
"The overlay for where IDL is currently stopped.")
(defvar idlwave-shell-is-stopped nil)
@@ -967,8 +950,6 @@ IDL has currently stepped.")
(setq idlwave-shell-default-directory default-directory)
(setq idlwave-shell-hide-output nil)
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
nil 'local)
(add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
@@ -1007,8 +988,6 @@ IDL has currently stepped.")
(set (make-local-variable 'comment-start) ";")
(setq abbrev-mode t)
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'idlwave-command-hook nil t)
;; Read the command history?
@@ -2751,6 +2730,7 @@ Runs to the last statement and then steps 1 statement.
Use the .out command."
;; Begin terrible hack section -- XEmacs tests for button2 explicitly
;; on drag events, calling drag-n-drop code if detected. Ughhh...
(defun idlwave-default-mouse-track-event-is-with-button (_event _n)
+ (declare (obsolete nil "28.1"))
t)
(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore
"27.1")
@@ -3612,10 +3592,8 @@ Existing overlays are recycled, in order to minimize
consumption."
(when use-glyph
(if old-buffers
(setq old-buffers (delq (current-buffer) old-buffers)))
- (if (fboundp 'set-specifier) ;; XEmacs
- (set-specifier left-margin-width (cons (current-buffer) 2))
- (if (< left-margin-width 2)
- (setq left-margin-width 2)))
+ (if (< left-margin-width 2)
+ (setq left-margin-width 2))
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
(set-window-margins
@@ -3623,9 +3601,7 @@ Existing overlays are recycled, in order to minimize
consumption."
(if use-glyph
(while (setq buf (pop old-buffers))
(with-current-buffer buf
- (if (fboundp 'set-specifier) ;; XEmacs
- (set-specifier left-margin-width (cons (current-buffer) 0))
- (setq left-margin-width 0))
+ (setq left-margin-width 0)
(let ((window (get-buffer-window buf 0)))
(if window
(set-window-margins
@@ -4352,21 +4328,19 @@ Shell debugging commands are available as single key
sequences."
["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
["Exit IDL" idlwave-shell-quit t]))
-(if (or (featurep 'easymenu) (load "easymenu" t))
- (progn
- (easy-menu-define
- idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
- idlwave-shell-menu-def)
- (easy-menu-define
- idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
- idlwave-shell-menu-def)
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (if (derived-mode-p 'idlwave-mode)
- (progn
- (easy-menu-remove idlwave-mode-debug-menu)
- (easy-menu-add idlwave-mode-debug-menu)))))))
+(easy-menu-define
+ idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
+ idlwave-shell-menu-def)
+(easy-menu-define
+ idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
+ idlwave-shell-menu-def)
+(save-current-buffer
+ (dolist (buf (buffer-list))
+ (set-buffer buf)
+ (if (derived-mode-p 'idlwave-mode)
+ (progn
+ (easy-menu-remove idlwave-mode-debug-menu)
+ (easy-menu-add idlwave-mode-debug-menu)))))
;; The Breakpoint Glyph -------------------------------------------------------
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 86f9f33..876c38d 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1355,8 +1355,8 @@ Normally a space.")
(defmacro idlwave-keyword-abbrev (&rest args)
"Creates a function for abbrev hooks to call `idlwave-check-abbrev' with
args."
- `(quote (lambda ()
- ,(append '(idlwave-check-abbrev) args))))
+ `(lambda ()
+ ,(append '(idlwave-check-abbrev) args)))
;; If I take the time I can replace idlwave-keyword-abbrev with
;; idlwave-code-abbrev and remove the quoted abbrev check from
@@ -1920,15 +1920,10 @@ The main features of this mode are
'idlwave-forward-block nil))
;; Make a local post-command-hook and add our hook to it
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
;; Make local hooks for buffer updates
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
- ;; (make-local-hook 'after-save-hook)
(add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
(add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
@@ -2781,10 +2776,7 @@ If the optional argument EXPAND is non-nil then the
actions in
;; Adjust parallel comment
(end-of-line)
(if (idlwave-in-comment)
- ;; Emacs 21 is too smart with fill-column on comment indent
- (let ((fill-column (if (fboundp 'comment-indent-new-line)
- (1- (frame-width))
- fill-column)))
+ (let ((fill-column (1- (frame-width))))
(indent-for-comment)))))
(goto-char mloc)
;; Get rid of marker
@@ -3996,12 +3988,7 @@ blank lines."
;; skip blank lines
(skip-chars-forward " \t\n")
(if (looking-at (concat "[ \t]*\\(" comment-start "+\\)"))
- (if (fboundp 'uncomment-region)
- (uncomment-region beg end)
- (comment-region beg end
- (- (length (buffer-substring
- (match-beginning 1)
- (match-end 1))))))
+ (uncomment-region beg end)
(comment-region beg end)))))
@@ -4047,11 +4034,6 @@ blank lines."
(defun idlwave-reset-sintern (&optional what)
"Reset all sintern hashes."
;; Make sure the hash functions are accessible.
- (unless (and (fboundp 'gethash)
- (fboundp 'puthash))
- (require 'cl)
- (or (fboundp 'puthash)
- (defalias 'puthash 'cl-puthash)))
(let ((entries '((idlwave-sint-routines 1000 10)
(idlwave-sint-keywords 1000 10)
(idlwave-sint-methods 100 10)
@@ -7642,14 +7624,13 @@ associated TAG, if any."
(defun idlwave-completion-fontify-classes ()
"Goto the *Completions* buffer and fontify the class info."
- (when (featurep 'font-lock)
- (with-current-buffer "*Completions*"
- (save-excursion
- (goto-char (point-min))
- (let ((buffer-read-only nil))
- (while (re-search-forward "\\.*<[^>]+>" nil t)
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'font-lock-string-face)))))))
+ (with-current-buffer "*Completions*"
+ (save-excursion
+ (goto-char (point-min))
+ (let ((buffer-read-only nil))
+ (while (re-search-forward "\\.*<[^>]+>" nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'font-lock-string-face))))))
(defun idlwave-uniquify (list)
(let ((ht (make-hash-table :size (length list) :test 'equal)))
@@ -8892,9 +8873,7 @@ Assumes that point is at the beginning of the unit as
found by
(let ((begin (point)))
(re-search-forward
"[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
- (if (fboundp 'buffer-substring-no-properties)
- (buffer-substring-no-properties begin (point))
- (buffer-substring begin (point)))))
+ (buffer-substring-no-properties begin (point))))
(defalias 'idlwave-function-menu
(condition-case nil
@@ -9010,8 +8989,7 @@ Assumes that point is at the beginning of the unit as
found by
("Customize"
["Browse IDLWAVE Group" idlwave-customize t]
"--"
- ["Build Full Customize Menu" idlwave-create-customize-menu
- (fboundp 'customize-menu-create)])
+ ["Build Full Customize Menu" idlwave-create-customize-menu t])
("Documentation"
["Describe Mode" describe-mode t]
["Abbreviation List" idlwave-list-abbrevs t]
@@ -9032,14 +9010,12 @@ Assumes that point is at the beginning of the unit as
found by
(and (boundp 'idlwave-shell-automatic-start)
idlwave-shell-automatic-start)]))
-(if (or (featurep 'easymenu) (load "easymenu" t))
- (progn
- (easy-menu-define idlwave-mode-menu idlwave-mode-map
- "IDL and WAVE CL editing menu"
- idlwave-mode-menu-def)
- (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
- "IDL and WAVE CL editing menu"
- idlwave-mode-debug-menu-def)))
+(easy-menu-define idlwave-mode-menu idlwave-mode-map
+ "IDL and WAVE CL editing menu"
+ idlwave-mode-menu-def)
+(easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
+ "IDL and WAVE CL editing menu"
+ idlwave-mode-debug-menu-def)
(defun idlwave-customize ()
"Call the customize function with `idlwave' as argument."
@@ -9053,24 +9029,21 @@ Assumes that point is at the beginning of the unit as
found by
(defun idlwave-create-customize-menu ()
"Create a full customization menu for IDLWAVE, insert it into the menu."
(interactive)
- (if (fboundp 'customize-menu-create)
- (progn
- ;; Try to load the code for the shell, so that we can customize it
- ;; as well.
- (or (featurep 'idlw-shell)
- (load "idlw-shell" t))
- (easy-menu-change
- '("IDLWAVE") "Customize"
- `(["Browse IDLWAVE group" idlwave-customize t]
- "--"
- ,(customize-menu-create 'idlwave)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]))
- (message "\"IDLWAVE\"-menu now contains full customization menu"))
- (error "Cannot expand menu (outdated version of cus-edit.el)")))
+ ;; Try to load the code for the shell, so that we can customize it
+ ;; as well.
+ (or (featurep 'idlw-shell)
+ (load "idlw-shell" t))
+ (easy-menu-change
+ '("IDLWAVE") "Customize"
+ `(["Browse IDLWAVE group" idlwave-customize t]
+ "--"
+ ,(customize-menu-create 'idlwave)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"IDLWAVE\"-menu now contains full customization menu"))
(defun idlwave-show-commentary ()
"Use the finder to view the file documentation from `idlwave.el'."
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 8596d78..3e49f84 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1370,13 +1370,11 @@ Fill comments, backslashed lines, and variable
definitions specially."
(goto-char (point-min))
(erase-buffer)
(mapconcat
- (function
- (lambda (item) (insert (makefile-browser-format-target-line (car item)
nil) "\n")))
+ (lambda (item) (insert (makefile-browser-format-target-line (car item)
nil) "\n"))
targets
"")
(mapconcat
- (function
- (lambda (item) (insert (makefile-browser-format-macro-line (car item)
nil) "\n")))
+ (lambda (item) (insert (makefile-browser-format-macro-line (car item)
nil) "\n"))
macros
"")
(sort-lines nil (point-min) (point-max))
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 7265aee..bb19436 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -209,7 +209,7 @@
(eval-and-compile
(defconst perl--syntax-exp-intro-keywords
'("split" "if" "unless" "until" "while" "print"
- "grep" "map" "not" "or" "and" "for" "foreach"))
+ "grep" "map" "not" "or" "and" "for" "foreach" "return"))
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 124f652..75e95d9 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -261,7 +261,6 @@
(require 'comint)
(eval-when-compile
- (require 'font-lock)
;; We need imenu everywhere because of the predicate index!
(require 'imenu)
;)
@@ -1883,8 +1882,6 @@ Argument BOUND is a buffer position limiting searching."
;; Set everything up
(defun prolog-font-lock-keywords ()
"Set up font lock keywords for the current Prolog system."
- ;;(when window-system
- (require 'font-lock)
;; Define Prolog faces
(defface prolog-redo-face
diff --git a/lisp/simple.el b/lisp/simple.el
index e96c7c9..bb28145 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5087,11 +5087,20 @@ visual feedback indicating the extent of the region
being copied."
(if (called-interactively-p 'interactive)
(indicate-copied-region)))
+(defcustom copy-region-blink-delay 1
+ "Time in seconds to delay after showing the other end of the region.
+It's used by the command `kill-ring-save' and the function
+`indicate-copied-region' to blink the cursor between point and mark.
+The value 0 disables blinking."
+ :type 'number
+ :group 'killing
+ :version "28.1")
+
(defun indicate-copied-region (&optional message-len)
"Indicate that the region text has been copied interactively.
-If the mark is visible in the selected window, blink the cursor
-between point and mark if there is currently no active region
-highlighting.
+If the mark is visible in the selected window, blink the cursor between
+point and mark if there is currently no active region highlighting.
+The option `copy-region-blink-delay' can disable blinking.
If the mark lies outside the selected window, display an
informative message containing a sample of the copied text. The
@@ -5105,12 +5114,14 @@ of this sample text; it defaults to 40."
(if (pos-visible-in-window-p mark (selected-window))
;; Swap point-and-mark quickly so as to show the region that
;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region nil t))
+ (when (and (numberp copy-region-blink-delay)
+ (> copy-region-blink-delay 0)
+ (or (not (region-active-p))
+ (not (face-background 'region nil t))))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char mark)
- (sit-for blink-matching-delay)
+ (sit-for copy-region-blink-delay)
;; Swap back.
(set-marker (mark-marker) mark (current-buffer))
(goto-char point)
@@ -5121,11 +5132,14 @@ of this sample text; it defaults to 40."
(let ((len (min (abs (- mark point))
(or message-len 40))))
(if (< point mark)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (buffer-substring-no-properties (- mark len) mark))
- (message "Saved text from \"%s\""
- (buffer-substring-no-properties mark (+ mark len))))))))
+ ;; Don't say "killed" or "saved"; that is misleading.
+ (message "Copied text until \"%s\""
+ ;; Don't show newlines literally
+ (query-replace-descr
+ (buffer-substring-no-properties (- mark len) mark)))
+ (message "Copied text from \"%s\""
+ (query-replace-descr
+ (buffer-substring-no-properties mark (+ mark len)))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to add to previous kill.
@@ -7421,18 +7435,17 @@ are interchanged."
With argument ARG, takes previous line and moves it past ARG lines.
With argument 0, interchanges line point is in with line mark is in."
(interactive "*p")
- (transpose-subr (function
- (lambda (arg)
- (if (> arg 0)
- (progn
- ;; Move forward over ARG lines,
- ;; but create newlines if necessary.
- (setq arg (forward-line arg))
- (if (/= (preceding-char) ?\n)
- (setq arg (1+ arg)))
- (if (> arg 0)
- (newline arg)))
- (forward-line arg))))
+ (transpose-subr (lambda (arg)
+ (if (> arg 0)
+ (progn
+ ;; Move forward over ARG lines,
+ ;; but create newlines if necessary.
+ (setq arg (forward-line arg))
+ (if (/= (preceding-char) ?\n)
+ (setq arg (1+ arg)))
+ (if (> arg 0)
+ (newline arg)))
+ (forward-line arg)))
arg))
;; FIXME seems to leave point BEFORE the current object when ARG = 0,
diff --git a/lisp/subr.el b/lisp/subr.el
index 2f35165..f9ca50f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2611,7 +2611,11 @@ This function is used by the `interactive' code letter
`n'."
Any input that is not one of CHARS is ignored.
If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
-keyboard-quit events while waiting for a valid input."
+keyboard-quit events while waiting for a valid input.
+
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result."
(unless (consp chars)
(error "Called `read-char-choice' without valid char choices"))
(let (char done show-help (helpbuf " *Char Help*"))
@@ -2772,8 +2776,11 @@ Optional argument HISTORY, if non-nil, should be a
symbol that
specifies the history list variable to use for navigating in input
history using `M-p' and `M-n', with `RET' to select a character from
history.
-If the caller has set `help-form', there is no need to explicitly add
-`help-char' to chars. It's bound automatically to `help-form-show'."
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result.
+There is no need to explicitly add `help-char' to CHARS;
+`help-char' is bound automatically to `help-form-show'."
(let* ((empty-history '())
(map (if (consp chars)
(or (gethash (list help-form (cons help-char chars))
@@ -2830,7 +2837,7 @@ If the caller has set `help-form', there is no need to
explicitly add
(define-key map [remap skip] 'y-or-n-p-insert-n)
- (dolist (symbol '(help backup undo undo-all edit edit-replacement
+ (dolist (symbol '(backup undo undo-all edit edit-replacement
delete-and-edit ignore self-insert-command))
(define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
@@ -2885,6 +2892,12 @@ Return t if answer is \"y\" and nil if it is \"n\".
PROMPT is the string to display to ask the question. It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result.
+PROMPT is also updated to show `help-char' like \"(y, n or C-h) \",
+where `help-char' is automatically bound to `help-form-show'.
+
No confirmation of the answer is requested; a single character is
enough. SPC also means yes, and DEL means no.
@@ -2907,7 +2920,13 @@ is nil and `use-dialog-box' is non-nil."
(concat prompt
(if (or (zerop l) (eq ?\s (aref prompt (1- l))))
"" " ")
- (if dialog "" "(y or n) "))))))
+ (if dialog ""
+ (if help-form
+ (format "(y, n or %s) "
+ (key-description
+ (vector help-char)))
+ "(y or n) "
+ )))))))
(cond
(noninteractive
(setq prompt (funcall padded prompt))
@@ -2916,6 +2935,7 @@ is nil and `use-dialog-box' is non-nil."
(let ((str (read-string temp-prompt)))
(cond ((member str '("y" "Y")) (setq answer 'act))
((member str '("n" "N")) (setq answer 'skip))
+ ((and (member str '("h" "H")) help-form) (print help-form))
(t (setq temp-prompt (concat "Please answer y or n. "
prompt))))))))
((and (display-popup-menus-p)
@@ -2928,10 +2948,20 @@ is nil and `use-dialog-box' is non-nil."
(setq prompt (funcall padded prompt))
(let* ((empty-history '())
(enable-recursive-minibuffers t)
+ (msg help-form)
+ (keymap (let ((map (make-composed-keymap
+ y-or-n-p-map query-replace-map)))
+ (when help-form
+ ;; Create a new map before modifying
+ (setq map (copy-keymap map))
+ (define-key map (vector help-char)
+ (lambda ()
+ (interactive)
+ (let ((help-form msg)) ; lexically bound msg
+ (help-form-show)))))
+ map))
(str (read-from-minibuffer
- prompt nil
- (make-composed-keymap y-or-n-p-map query-replace-map)
- nil
+ prompt nil keymap nil
(or y-or-n-p-history-variable 'empty-history))))
(setq answer (if (member str '("y" "Y")) 'act 'skip)))))
(let ((ret (eq answer 'act)))
diff --git a/lisp/term.el b/lisp/term.el
index 8cbbfff..585232b 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -123,13 +123,12 @@
;; full advantage of this package
;;
;; (add-hook 'term-mode-hook
-;; (function
-;; (lambda ()
-;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
-;; (setq-local mouse-yank-at-point t)
-;; (setq-local transient-mark-mode nil)
-;; (auto-fill-mode -1)
-;; (setq tab-width 8 ))))
+;; (lambda ()
+;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
+;; (setq-local mouse-yank-at-point t)
+;; (setq-local transient-mark-mode nil)
+;; (auto-fill-mode -1)
+;; (setq tab-width 8)))
;;
;; ----------------------------------------
;;
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index f153378..375a23e 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -568,46 +568,45 @@ default font on FRAME, or its best approximation."
(x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1"
'default frame)))
val)
- (mapc (function
- (lambda (script-desc)
- (let* ((script (car script-desc))
- (script-chars (vconcat (cdr script-desc)))
- (nchars (length script-chars))
- (fntlist all-fonts)
- (entry (list script))
- fspec ffont font-obj glyphs idx)
- ;; For each font in FNTLIST, determine whether it
- ;; supports the representative character(s) of any
- ;; scripts that have no USBs defined for it.
- (dolist (fnt fntlist)
- (setq fspec (ignore-errors (font-spec :name fnt)))
- (if fspec
- (setq ffont (find-font fspec frame)))
- (when ffont
- (setq font-obj
- (open-font ffont size frame))
- ;; Ignore fonts for which open-font returns nil:
- ;; they are buggy fonts that we cannot use anyway.
- (setq glyphs
- (if font-obj
- (font-get-glyphs font-obj
- 0 nchars script-chars)
- '[nil]))
- ;; Does this font support ALL of the script's
- ;; representative characters?
- (setq idx 0)
- (while (and (< idx nchars) (not (null (aref glyphs idx))))
- (setq idx (1+ idx)))
- (if (= idx nchars)
- ;; It does; add this font to the script's entry in
alist.
- (let ((font-family (font-get font-obj :family)))
- ;; Unifont is an ugly font, and it is already
- ;; present in the default fontset.
- (unless (string= (downcase (symbol-name font-family))
- "unifont")
- (push font-family entry))))))
- (if (> (length entry) 1)
- (push (nreverse entry) val)))))
+ (mapc (lambda (script-desc)
+ (let* ((script (car script-desc))
+ (script-chars (vconcat (cdr script-desc)))
+ (nchars (length script-chars))
+ (fntlist all-fonts)
+ (entry (list script))
+ fspec ffont font-obj glyphs idx)
+ ;; For each font in FNTLIST, determine whether it
+ ;; supports the representative character(s) of any
+ ;; scripts that have no USBs defined for it.
+ (dolist (fnt fntlist)
+ (setq fspec (ignore-errors (font-spec :name fnt)))
+ (if fspec
+ (setq ffont (find-font fspec frame)))
+ (when ffont
+ (setq font-obj
+ (open-font ffont size frame))
+ ;; Ignore fonts for which open-font returns nil:
+ ;; they are buggy fonts that we cannot use anyway.
+ (setq glyphs
+ (if font-obj
+ (font-get-glyphs font-obj
+ 0 nchars script-chars)
+ '[nil]))
+ ;; Does this font support ALL of the script's
+ ;; representative characters?
+ (setq idx 0)
+ (while (and (< idx nchars) (not (null (aref glyphs idx))))
+ (setq idx (1+ idx)))
+ (if (= idx nchars)
+ ;; It does; add this font to the script's entry in alist.
+ (let ((font-family (font-get font-obj :family)))
+ ;; Unifont is an ugly font, and it is already
+ ;; present in the default fontset.
+ (unless (string= (downcase (symbol-name font-family))
+ "unifont")
+ (push font-family entry))))))
+ (if (> (length entry) 1)
+ (push (nreverse entry) val))))
(w32--filter-USB-scripts))
;; We've opened a lot of fonts, so clear the font caches to free
;; some memory.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index fcf63ed..c9e21e5 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -88,6 +88,16 @@ If this is a function, call it to generate the initial field
text."
(const :tag "Default" t))
:risky t)
+(defcustom bibtex-unify-case-convert #'identity
+ "Function called when unifying case on entry and field names.
+It is called with one argument, the entry or field name."
+ :version "28.1"
+ :type '(choice (const :tag "Same case as in `bibtex-field-alist'" identity)
+ (const :tag "Downcase" downcase)
+ (const :tag "Capitalize" capitalize)
+ (const :tag "Upcase" upcase)
+ (function :tag "Conversion function")))
+
(defcustom bibtex-user-optional-fields
'(("annote" "Personal annotation (ignored)"))
"List of optional fields the user wants to have always present.
@@ -122,7 +132,8 @@ last-comma Add or delete comma on end of last
field in entry,
according to value of `bibtex-comma-after-last-field'.
delimiters Change delimiters according to variables
`bibtex-field-delimiters' and `bibtex-entry-delimiters'.
-unify-case Change case of entry types and field names.
+unify-case Change case of entry and field names according to
+ `bibtex-unify-case-convert'.
braces Enclose parts of field entries by braces according to
`bibtex-field-braces-alist'.
strings Replace parts of field entries by string constants
@@ -2346,7 +2357,7 @@ Formats current entry according to variable
`bibtex-entry-format'."
;; unify case of entry type
(when (memq 'unify-case format)
(delete-region beg-type end-type)
- (insert (car entry-list)))
+ (insert (funcall bibtex-unify-case-convert (car
entry-list))))
;; update left entry delimiter
(when (memq 'delimiters format)
@@ -2549,47 +2560,48 @@ Formats current entry according to variable
`bibtex-entry-format'."
(error "Mandatory field `%s' is empty" field-name))
;; unify case of field name
- (if (memq 'unify-case format)
- (let ((fname (car (assoc-string field-name
- default-field-list
t))))
- (if fname
- (progn
- (delete-region beg-name end-name)
- (goto-char beg-name)
- (insert fname))
- ;; there are no rules we could follow
- (downcase-region beg-name end-name))))
+ (when (memq 'unify-case format)
+ (let ((fname (car (assoc-string field-name
+ default-field-list t)))
+ (curname (buffer-substring beg-name end-name)))
+ (delete-region beg-name end-name)
+ (goto-char beg-name)
+ (insert (funcall bibtex-unify-case-convert
+ (or fname curname)))))
;; update point
(goto-char end-field))))
;; check whether all required fields are present
- (if (memq 'required-fields format)
- (let ((alt-expect (make-vector num-alt nil))
- (alt-found (make-vector num-alt 0)))
- (dolist (fname req-field-list)
- (cond ((setq idx (nth 3 fname))
- ;; t if field has alternative flag
- (bibtex-vec-push alt-expect idx (car fname))
- (if (member-ignore-case (car fname) field-list)
- (bibtex-vec-incr alt-found idx)))
- ((not (member-ignore-case (car fname) field-list))
- ;; If we use the crossref field, a required field
- ;; can have the OPT prefix. So if it was empty,
- ;; we have deleted by now. Nonetheless we can
- ;; move point on this empty field.
- (setq error-field-name (car fname))
- (error "Mandatory field `%s' is missing" (car
fname)))))
- (dotimes (idx num-alt)
- (cond ((= 0 (aref alt-found idx))
- (setq error-field-name (car (last (aref
alt-fields idx))))
- (error "Alternative mandatory field `%s' is
missing"
- (aref alt-expect idx)))
- ((< 1 (aref alt-found idx))
- (setq error-field-name (car (last (aref
alt-fields idx))))
- (error "Alternative fields `%s' are defined %s
times"
- (aref alt-expect idx)
- (length (aref alt-fields idx))))))))
+ (when (memq 'required-fields format)
+ (let ((alt-expect (make-vector num-alt nil))
+ (alt-found (make-vector num-alt 0)))
+ (dolist (fname req-field-list)
+ (cond ((setq idx (nth 3 fname))
+ ;; t if field has alternative flag
+ (bibtex-vec-push alt-expect idx (car fname))
+ (if (member-ignore-case (car fname) field-list)
+ (bibtex-vec-incr alt-found idx)))
+ ((not (member-ignore-case (car fname) field-list))
+ ;; If we use the crossref field, a required field
+ ;; can have the OPT prefix. So if it was empty,
+ ;; we have deleted by now. Nonetheless we can
+ ;; move point on this empty field.
+ (setq error-field-name (car fname))
+ (error "Mandatory field `%s' is missing"
+ (car fname)))))
+ (dotimes (idx num-alt)
+ (cond ((= 0 (aref alt-found idx))
+ (setq error-field-name
+ (car (last (aref alt-fields idx))))
+ (error "Alternative mandatory field `%s' is missing"
+ (aref alt-expect idx)))
+ ((< 1 (aref alt-found idx))
+ (setq error-field-name
+ (car (last (aref alt-fields idx))))
+ (error "Alternative fields `%s' are defined %s times"
+ (aref alt-expect idx)
+ (length (aref alt-fields idx))))))))
;; update comma after last field
(if (memq 'last-comma format)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index adda28c..7a7ac47 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -3578,8 +3578,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font lock
-(require 'font-lock)
-
;; FIXME: The obsolete variables need to disappear.
;; The following versions have been done inside Emacs and should not be
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 25aa580..065fdd0 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -3270,34 +3270,33 @@ Currently this method is for LaTeX only."
(let* ((span 1) ;; spanning length
(first-p t) ;; first in a row
(insert-column ;; a function that processes one
column/multicolumn
- (function
- (lambda (from to)
- (let ((line (table--buffer-substring-and-trim
- (table--goto-coordinate (cons from y))
- (table--goto-coordinate (cons to y)))))
- ;; escape special characters
- (with-temp-buffer
- (insert line)
- (goto-char (point-min))
- (while (re-search-forward
"\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
- (if (match-beginning 1)
- (save-excursion
- (goto-char (match-beginning 1))
- (insert "\\"))
- (if (match-beginning 2)
- (replace-match "$\\backslash$" t t)
- (replace-match (concat "$" (match-string 3)
"$")) t t)))
- (setq line (buffer-substring (point-min) (point-max))))
- ;; insert a column separator and column/multicolumn
contents
- (with-current-buffer dest-buffer
- (unless first-p
- (insert (if (eq (char-before) ?\s) "" " ") "& "))
- (if (> span 1)
- (insert (format "\\multicolumn{%d}{%sl|}{%s}" span
(if first-p "|" "") line))
- (insert line)))
- (setq first-p nil)
- (setq span 1)
- (setq start (nth i col-list)))))))
+ (lambda (from to)
+ (let ((line (table--buffer-substring-and-trim
+ (table--goto-coordinate (cons from y))
+ (table--goto-coordinate (cons to y)))))
+ ;; escape special characters
+ (with-temp-buffer
+ (insert line)
+ (goto-char (point-min))
+ (while (re-search-forward
"\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
+ (if (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (insert "\\"))
+ (if (match-beginning 2)
+ (replace-match "$\\backslash$" t t)
+ (replace-match (concat "$" (match-string 3)
"$")) t t)))
+ (setq line (buffer-substring (point-min) (point-max))))
+ ;; insert a column separator and column/multicolumn
contents
+ (with-current-buffer dest-buffer
+ (unless first-p
+ (insert (if (eq (char-before) ?\s) "" " ") "& "))
+ (if (> span 1)
+ (insert (format "\\multicolumn{%d}{%sl|}{%s}" span
(if first-p "|" "") line))
+ (insert line)))
+ (setq first-p nil)
+ (setq span 1)
+ (setq start (nth i col-list))))))
(setq start x0)
(setq i 1)
(while (setq c (nth i border-char-list))
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 7c64f29..c50d68b 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -1,4 +1,4 @@
-;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
+;;; time-stamp.el --- Maintain last change time stamps in files edited by
Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software
;; Foundation, Inc.
@@ -87,7 +87,6 @@ transitional behavior (again, as shown).
The behavior of `%5z' is new in Emacs 27. If your files might be
edited by older versions of Emacs also, do not use this format yet."
:type 'string
- :group 'time-stamp
:version "27.1")
;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp)
@@ -102,8 +101,7 @@ when they are saved, either add this line to your init file:
or customize option `before-save-hook'.
See also the variable `time-stamp-warn-inactive'."
- :type 'boolean
- :group 'time-stamp)
+ :type 'boolean)
(defcustom time-stamp-warn-inactive t
"Have \\[time-stamp] warn if a buffer did not get time-stamped.
@@ -111,7 +109,6 @@ If non-nil, a warning is displayed if `time-stamp-active'
has
deactivated time stamping and the buffer contains a template that
otherwise would have been updated."
:type 'boolean
- :group 'time-stamp
:version "19.29")
(defcustom time-stamp-time-zone nil
@@ -125,7 +122,6 @@ Its format is that of the ZONE argument of the
`format-time-string' function."
(integer :tag "Offset (seconds east of UTC)")
(string :tag "Time zone abbreviation"))
(integer :tag "Offset (seconds east of UTC)"))
- :group 'time-stamp
:version "20.1")
;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable
'time-stamp-zone-type-p)
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index fd800cd..bcb48aa 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -23,7 +23,6 @@
(require 'url-vars)
(require 'url-parse)
-(autoload 'url-warn "url")
(autoload 'auth-source-search "auth-source")
(defsubst url-auth-user-prompt (url realm)
@@ -540,7 +539,7 @@ RATING a rating between 1 and 10 of the strength of the
authentication.
(t rating)))
(node (assoc type url-registered-auth-schemes)))
(if (not (fboundp function))
- (url-warn
+ (display-warning
'security
(format-message
"Tried to register `%s' as an auth scheme, but it is not a function!"
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8532da1..75330d3 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1119,9 +1119,7 @@ the end of the document."
(beginning-of-line)
(looking-at regexp))
(add-text-properties (match-beginning 0) (match-end 0)
- (list 'start-open t
- 'end-open t
- 'chunked-encoding t
+ (list 'chunked-encoding t
'face 'cursor
'invisible t))
(setq url-http-chunked-length (string-to-number (buffer-substring
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 9ef17cc..78a6aa9 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -25,7 +25,6 @@
(require 'url-util)
(require 'url-parse)
(require 'nntp)
-(autoload 'url-warn "url")
(autoload 'gnus-group-read-ephemeral-group "gnus-group")
;; Unused.
@@ -42,7 +41,7 @@
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
(nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
(if (not (nntp-server-opened host))
- (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
+ (display-warning 'url (format "NNTP authentication to `%s' as `%s'
failed"
host user))))))
(defun url-news-fetch-message-id (host message-id)
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 9513c39..698a870 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -22,7 +22,6 @@
;;; Code:
(require 'url-parse)
-(autoload 'url-warn "url")
(defun url-default-find-proxy-for-url (urlobj host)
(cond
@@ -60,7 +59,7 @@
((string-match "^socks +" proxy)
(concat "socks://" (substring proxy (match-end 0))))
(t
- (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical)
+ (display-warning 'url (format "Unknown proxy directive: %s" proxy)
'critical)
nil))))
(autoload 'url-http "url-http")
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 33a5ebc..5188007 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -365,19 +365,7 @@ how long to wait for a response before giving up."
(if (buffer-live-p buff)
(kill-buffer buff)))))
-(cond
- ((fboundp 'display-warning)
- (defalias 'url-warn 'display-warning))
- ((fboundp 'warn)
- (defun url-warn (class message &optional level)
- (warn "(%s/%s) %s" class (or level 'warning) message)))
- (t
- (defun url-warn (class message &optional level)
- (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
- (goto-char (point-max))
- (save-excursion
- (insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
- (display-buffer (current-buffer))))))
+(define-obsolete-function-alias 'url-warn #'display-warning "28.1")
(provide 'url)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 5aeb8fe..0a90613 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -403,7 +403,8 @@ well."
'((((class color))
:foreground "red" :background "black" :weight bold)
(t :weight bold))
- "`diff-mode' face for error messages from diff.")
+ "`diff-mode' face for error messages from diff."
+ :version "28.1")
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index a23d720..c68dc71 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -42,13 +42,6 @@
(require 'ediff-help)
;; end pacifier
-
-;; be careful with ediff-tbar
-(eval-and-compile
- (if (featurep 'xemacs)
- (require 'ediff-tbar)
- (defun ediff-compute-toolbar-width () 0)))
-
(defgroup ediff-window nil
"Ediff window manipulation."
:prefix "ediff-"
@@ -961,8 +954,7 @@ create a new splittable frame if none is found."
;; 1 more line for the mode line
(setq lines (1+ (count-lines (point-min) (point-max)))
fheight lines
- fwidth (max (+ (ediff-help-message-line-length) 2)
- (ediff-compute-toolbar-width))
+ fwidth (max (+ (ediff-help-message-line-length) 2) 0)
adjusted-parameters
(list
;; possibly change surrogate minibuffer
@@ -1291,6 +1283,9 @@ It assumes that it is called from within the control
buffer."
(ediff-multiframe-setup-p)
ediff-wide-display-p)))))))
+(defun ediff-compute-toolbar-width ()
+ (declare (obsolete nil "28.1"))
+ 0)
(provide 'ediff-wind)
;;; ediff-wind.el ends here
diff --git a/nt/INSTALL b/nt/INSTALL
index 2fe2c8c..27fb5f0 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -502,11 +502,21 @@ build will run on Windows 9X and newer systems).
Does Emacs use -lgnutls? yes
Does Emacs use -lxml2? yes
Does Emacs use -lfreetype? no
+ Does Emacs use HarfBuzz? yes
Does Emacs use -lm17n-flt? no
Does Emacs use -lotf? no
Does Emacs use -lxft? no
+ Does Emacs use -lsystemd? no
+ Does Emacs use -ljansson? yes
+ Does Emacs use the GMP library? yes
Does Emacs directly use zlib? yes
+ Does Emacs have dynamic modules support? yes
Does Emacs use toolkit scroll bars? yes
+ Does Emacs support Xwidgets? no
+ Does Emacs have threading support in lisp? yes
+ Does Emacs support the portable dumper? yes
+ Does Emacs support the legacy unexec dumping? no
+ Which dumping strategy does Emacs use? pdumper
You are almost there, hang on.
@@ -815,6 +825,14 @@ build will run on Windows 9X and newer systems).
the libjansson DLL (for 32-bit builds of Emacs) are available from
the ezwinports site and from the MSYS2 project.
+* Optional support for HarfBuzzz shaping library
+
+ Emacs supports display of complex scripts and Arabic shaping. The
+ preferred library for that is HarfBuzz; prebuilt binaries are
+ available from the ezwinports site (for 32-bit builds of Emacs) and
+ from the MSYS2 project. If HarfBuzz is not available, Emacs will
+ use the Uniscribe shaping engine that is part of MS-Windows.
+
This file is part of GNU Emacs.
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index 0a0e033..4724116 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -55,14 +55,16 @@ packages (you can copy and paste it into the shell with
Shift + Insert):
mingw-w64-x86_64-jansson \
mingw-w64-x86_64-libxml2 \
mingw-w64-x86_64-gnutls \
- mingw-w64-x86_64-zlib
+ mingw-w64-x86_64-zlib \
+ mingw-w64-x86_64-harfbuzz
The packages include the base developer tools (autoconf, grep, make, etc.),
the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML
-library, the GnuTLS (transport layer security) library, and zlib for
-decompressing text. Only the first three packages are required (base-devel,
-toolchain, xpm-nox); the rest are optional. You can select only part of the
-libraries if you don't need them all.
+library, the GnuTLS (transport layer security) library, zlib for
+decompressing text, and HarfBuzz for use as the shaping engine. Only the
+first three packages are required (base-devel, toolchain, xpm-nox); the
+rest are optional. You can select only part of the libraries if you don't
+need them all.
You now have a complete build environment for Emacs.
diff --git a/src/buffer.c b/src/buffer.c
index 4fd2b0c..360dd34 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -297,11 +297,6 @@ bset_mark (struct buffer *b, Lisp_Object val)
b->mark_ = val;
}
static void
-bset_minor_modes (struct buffer *b, Lisp_Object val)
-{
- b->minor_modes_ = val;
-}
-static void
bset_mode_line_format (struct buffer *b, Lisp_Object val)
{
b->mode_line_format_ = val;
@@ -1004,7 +999,6 @@ reset_buffer_local_variables (struct buffer *b, bool
permanent_too)
bset_major_mode (b, Qfundamental_mode);
bset_keymap (b, Qnil);
bset_mode_name (b, QSFundamental);
- bset_minor_modes (b, Qnil);
/* If the standard case table has been altered and invalidated,
fix up its insides first. */
@@ -5180,7 +5174,6 @@ init_buffer_once (void)
bset_upcase_table (&buffer_local_flags, make_fixnum (0));
bset_case_canon_table (&buffer_local_flags, make_fixnum (0));
bset_case_eqv_table (&buffer_local_flags, make_fixnum (0));
- bset_minor_modes (&buffer_local_flags, make_fixnum (0));
bset_width_table (&buffer_local_flags, make_fixnum (0));
bset_pt_marker (&buffer_local_flags, make_fixnum (0));
bset_begv_marker (&buffer_local_flags, make_fixnum (0));
diff --git a/src/buffer.h b/src/buffer.h
index 3da4941..fe549c5 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -419,9 +419,6 @@ struct buffer
/* Non-nil means show ... at end of line followed by invisible lines. */
Lisp_Object selective_display_ellipses_;
- /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
- Lisp_Object minor_modes_;
-
/* t if "self-insertion" should overwrite; `binary' if it should also
overwrite newlines and tabs - for editing executables and the like. */
Lisp_Object overwrite_mode_;
diff --git a/src/data.c b/src/data.c
index c6629dd..1435cb0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1501,10 +1501,14 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
{
int offset = XBUFFER_OBJFWD (innercontents)->offset;
int idx = PER_BUFFER_IDX (offset);
- if (idx > 0
- && bindflag == SET_INTERNAL_SET
- && !let_shadows_buffer_binding_p (sym))
- SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ if (idx > 0 && bindflag == SET_INTERNAL_SET
+ && !PER_BUFFER_VALUE_P (buf, idx))
+ {
+ if (let_shadows_buffer_binding_p (sym))
+ set_default_internal (symbol, newval, bindflag);
+ else
+ SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ }
}
if (voide)
diff --git a/src/dispnew.c b/src/dispnew.c
index 479fccb..89dd32a 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -2558,11 +2558,15 @@ build_frame_matrix_from_leaf_window (struct
glyph_matrix *frame_matrix, struct w
the corresponding frame row to be updated. */
frame_row->enabled_p = true;
- /* Maybe insert a vertical border between horizontally adjacent
+ /* Maybe insert a vertical border between horizontally adjacent
windows. */
- if (GLYPH_CHAR (right_border_glyph) != 0)
+ if (GLYPH_CHAR (right_border_glyph) != 0)
{
- struct glyph *border = window_row->glyphs[LAST_AREA] - 1;
+ struct glyph *border = window_row->glyphs[LAST_AREA] - 1;
+ /* It's a subtle bug if we are overwriting some non-char
+ glyph with the vertical border glyph. */
+ eassert (border->type == CHAR_GLYPH);
+ border->type = CHAR_GLYPH;
SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph);
}
diff --git a/src/fns.c b/src/fns.c
index f50bf8e..e4c9acc 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5502,25 +5502,32 @@ Case is always significant and text properties are
ignored. */)
haybytes = SBYTES (haystack) - start_byte;
/* We can do a direct byte-string search if both strings have the
- same multibyteness, or if at least one of them consists of ASCII
- characters only. */
+ same multibyteness, or if the needle consists of ASCII characters only.
*/
if (STRING_MULTIBYTE (haystack)
? (STRING_MULTIBYTE (needle)
|| SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle))
: (!STRING_MULTIBYTE (needle)
- || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack)))
- res = memmem (haystart, haybytes,
- SSDATA (needle), SBYTES (needle));
- else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */
+ || SCHARS (needle) == SBYTES (needle)))
+ {
+ if (STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle)
+ && SCHARS (haystack) == SBYTES (haystack)
+ && SCHARS (needle) != SBYTES (needle))
+ /* Multibyte non-ASCII needle, multibyte ASCII haystack: impossible.
*/
+ return Qnil;
+ else
+ res = memmem (haystart, haybytes,
+ SSDATA (needle), SBYTES (needle));
+ }
+ else if (STRING_MULTIBYTE (haystack)) /* unibyte non-ASCII needle */
{
Lisp_Object multi_needle = string_to_multibyte (needle);
res = memmem (haystart, haybytes,
SSDATA (multi_needle), SBYTES (multi_needle));
}
- else /* unibyte haystack, multibyte needle */
+ else /* unibyte haystack, multibyte non-ASCII needle */
{
/* The only possible way we can find the multibyte needle in the
- unibyte stack (since we know that neither are pure-ASCII) is
+ unibyte stack (since we know that the needle is non-ASCII) is
if they contain "raw bytes" (and no other non-ASCII chars.) */
ptrdiff_t nbytes = SBYTES (needle);
for (ptrdiff_t i = 0; i < nbytes; i++)
diff --git a/src/image.c b/src/image.c
index 3858f3c..5eb4132 100644
--- a/src/image.c
+++ b/src/image.c
@@ -9551,10 +9551,9 @@ DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions,
DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer,
(RsvgHandle *, const char *, const RsvgRectangle *,
RsvgRectangle *, RsvgRectangle *, GError **));
-# else
+# endif
DEF_DLL_FN (void, rsvg_handle_get_dimensions,
(RsvgHandle *, RsvgDimensionData *));
-# endif
DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *));
DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *));
DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *));
@@ -9604,9 +9603,8 @@ init_svg_functions (void)
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer);
-#else
- LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
#endif
+ LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_pixbuf);
LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width);
@@ -9644,9 +9642,8 @@ init_svg_functions (void)
# if LIBRSVG_CHECK_VERSION (2, 46, 0)
# undef rsvg_handle_get_intrinsic_dimensions
# undef rsvg_handle_get_geometry_for_layer
-# else
-# undef rsvg_handle_get_dimensions
# endif
+# undef rsvg_handle_get_dimensions
# undef rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# undef g_file_new_for_path
@@ -9677,9 +9674,8 @@ init_svg_functions (void)
fn_rsvg_handle_get_intrinsic_dimensions
# define rsvg_handle_get_geometry_for_layer \
fn_rsvg_handle_get_geometry_for_layer
-# else
-# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
# endif
+# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# define g_file_new_for_path fn_g_file_new_for_path
@@ -9903,30 +9899,21 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
viewbox_width = viewbox.x + viewbox.width;
viewbox_height = viewbox.y + viewbox.height;
}
-#else
- /* The function used above to get the geometry of the visible area
- of the SVG are only available in librsvg 2.46 and above, so in
- certain circumstances this code path can result in some parts of
- the SVG being cropped. */
- RsvgDimensionData dimension_data;
- rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
-
- viewbox_width = dimension_data.width;
- viewbox_height = dimension_data.height;
+ if (viewbox_width == 0 || viewbox_height == 0)
#endif
+ {
+ /* The functions used above to get the geometry of the visible
+ area of the SVG are only available in librsvg 2.46 and above,
+ so in certain circumstances this code path can result in some
+ parts of the SVG being cropped. */
+ RsvgDimensionData dimension_data;
- if (viewbox_width == 0 || viewbox_height == 0)
- {
- /* We do not have any usable dimensions, so make some up. The
- values below are supposedly the default values most web
- browsers use for SVGs with no set size. */
- /* FIXME: At this stage we should perhaps consider rendering the
- image out to a bitmap and getting the dimensions from
- that. */
- viewbox_width = 300;
- viewbox_height = 150;
- }
+ rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
+
+ viewbox_width = dimension_data.width;
+ viewbox_height = dimension_data.height;
+ }
compute_image_size (viewbox_width, viewbox_height, img->spec,
&width, &height);
diff --git a/src/keyboard.c b/src/keyboard.c
index 49a0a8b..49261fc 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2122,7 +2122,7 @@ read_char_help_form_unwind (void)
Lisp_Object window_config = XCAR (help_form_saved_window_configs);
help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
if (!NILP (window_config))
- Fset_window_configuration (window_config);
+ Fset_window_configuration (window_config, Qnil);
}
#define STOP_POLLING \
@@ -3736,9 +3736,6 @@ discard_mouse_events (void)
if (sp->kind == MOUSE_CLICK_EVENT
|| sp->kind == WHEEL_EVENT
|| sp->kind == HORIZ_WHEEL_EVENT
-#ifdef HAVE_GPM
- || sp->kind == GPM_CLICK_EVENT
-#endif
|| sp->kind == SCROLL_BAR_CLICK_EVENT
|| sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
{
@@ -5542,9 +5539,6 @@ make_lispy_event (struct input_event *event)
/* A mouse click. Figure out where it is, decide whether it's
a press, click or drag, and build the appropriate structure. */
case MOUSE_CLICK_EVENT:
-#ifdef HAVE_GPM
- case GPM_CLICK_EVENT:
-#endif
#ifndef USE_TOOLKIT_SCROLL_BARS
case SCROLL_BAR_CLICK_EVENT:
case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
@@ -5559,11 +5553,7 @@ make_lispy_event (struct input_event *event)
position = Qnil;
/* Build the position as appropriate for this mouse click. */
- if (event->kind == MOUSE_CLICK_EVENT
-#ifdef HAVE_GPM
- || event->kind == GPM_CLICK_EVENT
-#endif
- )
+ if (event->kind == MOUSE_CLICK_EVENT)
{
struct frame *f = XFRAME (event->frame_or_window);
int row, column;
diff --git a/src/keymap.c b/src/keymap.c
index 181dcda..e22eb41 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3085,6 +3085,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
for (i = from; ; i++)
{
bool this_shadowed = 0;
+ Lisp_Object shadowed_by = Qnil;
int range_beg, range_end;
Lisp_Object val;
@@ -3127,11 +3128,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
/* If this binding is shadowed by some other map, ignore it. */
if (!NILP (shadow))
{
- Lisp_Object tem;
-
- tem = shadow_lookup (shadow, kludge, Qt, 0);
+ shadowed_by = shadow_lookup (shadow, kludge, Qt, 0);
- if (!NILP (tem))
+ if (!NILP (shadowed_by) && !EQ (shadowed_by, definition))
{
if (mention_shadow)
this_shadowed = 1;
@@ -3186,6 +3185,21 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
&& !NILP (Fequal (tem2, definition)))
i++;
+ /* Make sure found consecutive keys are either not shadowed or,
+ if they are, that they are shadowed by the same command. */
+ if (CHAR_TABLE_P (vector) && i != starting_i)
+ {
+ Lisp_Object tem;
+ Lisp_Object key = make_nil_vector (1);
+ for (int j = starting_i + 1; j <= i; j++)
+ {
+ ASET (key, 0, make_fixnum (j));
+ tem = shadow_lookup (shadow, key, Qt, 0);
+ if (NILP (Fequal (tem, shadowed_by)))
+ i = j - 1;
+ }
+ }
+
/* If we have a range of more than one character,
print where the range reaches to. */
@@ -3209,7 +3223,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
if (this_shadowed)
{
SET_PT (PT - 1);
- insert_string (" (binding currently shadowed)");
+ static char const fmt[] = " (currently shadowed by `%s')";
+ USE_SAFE_ALLOCA;
+ char *buffer = SAFE_ALLOCA (sizeof fmt +
+ SBYTES (SYMBOL_NAME (shadowed_by)));
+ esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by)));
+ insert_string (buffer);
+ SAFE_FREE();
SET_PT (PT + 1);
}
}
diff --git a/src/minibuf.c b/src/minibuf.c
index c4adca1..464e301 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -501,14 +501,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
record_unwind_protect_void (choose_minibuf_frame);
record_unwind_protect (restore_window_configuration,
- Fcurrent_window_configuration (Qnil));
+ Fcons (Qt, Fcurrent_window_configuration (Qnil)));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (!EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
- Fcurrent_window_configuration (mini_frame));
+ Fcons (Qt,
+ Fcurrent_window_configuration (mini_frame)));
/* If the minibuffer is on an iconified or invisible frame,
make it visible now. */
diff --git a/src/term.c b/src/term.c
index a073859..fee3b55 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2481,7 +2481,7 @@ term_mouse_click (struct input_event *result, Gpm_Event
*event,
{
int i, j;
- result->kind = GPM_CLICK_EVENT;
+ result->kind = MOUSE_CLICK_EVENT;
for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 )
{
if (event->buttons & j) {
@@ -2567,11 +2567,11 @@ handle_one_term_event (struct tty_display_info *tty,
Gpm_Event *event)
{
f->mouse_moved = 0;
term_mouse_click (&ie, event, f);
- /* eassert (ie.kind == GPM_CLICK_EVENT); */
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
if (tty_handle_tab_bar_click (f, event->x, event->y,
(ie.modifiers & down_modifier) != 0, &ie))
{
- /* eassert (ie.kind == GPM_CLICK_EVENT
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT
* || ie.kind == TAB_BAR_EVENT); */
/* tty_handle_tab_bar_click stores 2 events in the event
queue, so we are done here. */
@@ -2581,7 +2581,7 @@ handle_one_term_event (struct tty_display_info *tty,
Gpm_Event *event)
count += 2;
return count;
}
- /* eassert (ie.kind == GPM_CLICK_EVENT); */
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
kbd_buffer_store_event (&ie);
count++;
}
diff --git a/src/termhooks.h b/src/termhooks.h
index 6ab06ce..44ab142 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -220,10 +220,6 @@ enum event_kind
save yourself before shutdown. */
SAVE_SESSION_EVENT
-#ifdef HAVE_GPM
- , GPM_CLICK_EVENT
-#endif
-
#ifdef HAVE_DBUS
, DBUS_EVENT
#endif
diff --git a/src/w32term.c b/src/w32term.c
index e0618e4..23cb380 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -7165,15 +7165,21 @@ w32_initialize_display_info (Lisp_Object display_name)
memset (dpyinfo, 0, sizeof (*dpyinfo));
dpyinfo->name_list_element = Fcons (display_name, Qnil);
+ static char const title[] = "GNU Emacs";
if (STRINGP (Vsystem_name))
{
- dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name)
- + SCHARS (Vsystem_name) + 2);
- sprintf (dpyinfo->w32_id_name, "%s@%s",
- SDATA (Vinvocation_name), SDATA (Vsystem_name));
+ static char const at[] = " at ";
+ ptrdiff_t nbytes = sizeof (title) + sizeof (at);
+ if (INT_ADD_WRAPV (nbytes, SCHARS (Vsystem_name), &nbytes))
+ memory_full (SIZE_MAX);
+ dpyinfo->w32_id_name = xmalloc (nbytes);
+ sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA
(Vsystem_name));
}
else
- dpyinfo->w32_id_name = xlispstrdup (Vinvocation_name);
+ {
+ dpyinfo->w32_id_name = xmalloc (sizeof (title));
+ strcpy (dpyinfo->w32_id_name, title);
+ }
/* Default Console mode values - overridden when running in GUI mode
with values obtained from system metrics. */
diff --git a/src/window.c b/src/window.c
index a6de34f..6cd3122 100644
--- a/src/window.c
+++ b/src/window.c
@@ -6824,19 +6824,25 @@ DEFUN ("window-configuration-frame",
Fwindow_configuration_frame, Swindow_config
}
DEFUN ("set-window-configuration", Fset_window_configuration,
- Sset_window_configuration, 1, 1, 0,
+ Sset_window_configuration, 1, 2, 0,
doc: /* Set the configuration of windows and buffers as specified by
CONFIGURATION.
CONFIGURATION must be a value previously returned
by `current-window-configuration' (which see).
+
+Normally, this function selects the frame of the CONFIGURATION, but if
+DONT-SET-FRAME is non-nil, it leaves selected the frame which was
+current at the start of the function.
+
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
the return value is nil. Otherwise the value is t. */)
- (Lisp_Object configuration)
+ (Lisp_Object configuration, Lisp_Object dont_set_frame)
{
register struct save_window_data *data;
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
+ Lisp_Object old_frame = selected_frame;
struct frame *f;
ptrdiff_t old_point = -1;
USE_SAFE_ALLOCA;
@@ -7153,7 +7159,10 @@ the return value is nil. Otherwise the value is t. */)
select_window above totally superfluous; it still sets f's
selected window. */
if (FRAME_LIVE_P (XFRAME (data->selected_frame)))
- do_switch_frame (data->selected_frame, 0, 0, Qnil);
+ do_switch_frame (NILP (dont_set_frame)
+ ? data->selected_frame
+ : old_frame
+ , 0, 0, Qnil);
}
FRAME_WINDOW_CHANGE (f) = true;
@@ -7187,11 +7196,13 @@ the return value is nil. Otherwise the value is t. */)
return FRAME_LIVE_P (f) ? Qt : Qnil;
}
-
void
restore_window_configuration (Lisp_Object configuration)
{
- Fset_window_configuration (configuration);
+ if (CONSP (configuration))
+ Fset_window_configuration (XCDR (configuration), XCAR (configuration));
+ else
+ Fset_window_configuration (configuration, Qnil);
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 2344fe7..e49cc43 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -22272,14 +22272,15 @@ extend_face_to_end_of_line (struct it *it)
default_face->id : face->id);
/* Display fill-column indicator if needed. */
- /* We need to subtract 1 to the indicator_column here because we
- will add the indicator IN the column indicator number, not
- after it. We compare the variable it->current_x before
- producing the glyph. When FRAME_WINDOW_P we subtract
- CHAR_WIDTH calculating STRETCH_WIDTH for the same reason. */
- const int indicator_column =
- fill_column_indicator_column (it, 1) - 1;
- do
+ const int indicator_column = fill_column_indicator_column (it, 1);
+
+ /* Make sure our idea of current_x is in sync with the glyphs
+ actually in the glyph row. They might differ because
+ append_space_for_newline can insert one glyph without
+ updating current_x. */
+ it->current_x = it->glyph_row->used[TEXT_AREA];
+
+ while (it->current_x <= it->last_visible_x)
{
if (it->current_x != indicator_column)
PRODUCE_GLYPHS (it);
@@ -22297,7 +22298,6 @@ extend_face_to_end_of_line (struct it *it)
it->c = it->char_to_display = ' ';
}
}
- while (it->current_x <= it->last_visible_x);
if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0
&& (it->glyph_row->used[RIGHT_MARGIN_AREA]
diff --git a/src/xterm.c b/src/xterm.c
index 98bb0ea..0d2452d 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -12928,19 +12928,23 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif
Lisp_Object system_name = Fsystem_name ();
-
- ptrdiff_t nbytes = SBYTES (Vinvocation_name) + 1;
- if (STRINGP (system_name)
- && INT_ADD_WRAPV (nbytes, SBYTES (system_name) + 1, &nbytes))
- memory_full (SIZE_MAX);
- dpyinfo->x_id = ++x_display_id;
- dpyinfo->x_id_name = xmalloc (nbytes);
- char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name);
+ static char const title[] = "GNU Emacs";
if (STRINGP (system_name))
{
- *nametail++ = '@';
- lispstpcpy (nametail, system_name);
+ static char const at[] = " at ";
+ ptrdiff_t nbytes = sizeof (title) + sizeof (at);
+ if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes))
+ memory_full (SIZE_MAX);
+ dpyinfo->x_id_name = xmalloc (nbytes);
+ sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name));
}
+ else
+ {
+ dpyinfo->x_id_name = xmalloc (sizeof (title));
+ strcpy (dpyinfo->x_id_name, title);
+ }
+
+ dpyinfo->x_id = ++x_display_id;
/* Figure out which modifier bits mean what. */
x_find_modifier_meanings (dpyinfo);
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index e537871..bcbd7d6 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -38,14 +38,9 @@
(defvar semantic-utest-test-directory (expand-file-name "tests"
cedet-utest-directory)
"Location of test files.")
-(defvar semantic-utest-temp-directory (if (fboundp 'temp-directory)
- (temp-directory)
- temporary-file-directory)
- "Temporary directory to use when creating files.")
-
(defun semantic-utest-fname (name)
"Create a filename for NAME in /tmp."
- (expand-file-name name semantic-utest-temp-directory))
+ (expand-file-name name temporary-file-directory))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data for C tests
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
new file mode 100644
index 0000000..bb88b8d
--- /dev/null
+++ b/test/lisp/cus-edit-tests.el
@@ -0,0 +1,80 @@
+;;; cus-edit-tests.el --- Tests for cus-edit.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(eval-when-compile (require 'cl-lib))
+(require 'cus-edit)
+
+(defmacro with-cus-edit-test (buffer &rest body)
+ (declare (indent 1))
+ `(save-window-excursion
+ (unwind-protect
+ (progn ,@body)
+ (when-let ((buf (get-buffer ,buffer)))
+ (kill-buffer buf)))))
+
+
+;;;; showing/hiding obsolete options
+
+(defgroup cus-edit-tests nil "test"
+ :group 'test-group)
+
+(defcustom cus-edit-tests--obsolete-option-tag nil
+ "This should never be removed; it is obsolete for testing purposes."
+ :type 'boolean
+ :version "917.10") ; a super high version number
+(make-obsolete-variable 'cus-edit-tests--obsolete-option-tag nil "X.X-test")
+(defconst cus-edit-tests--obsolete-option-tag
+ (custom-unlispify-tag-name 'cus-edit-tests--obsolete-option-tag))
+
+(ert-deftest cus-edit-tests-customize-apropos/hide-obsolete ()
+ (with-cus-edit-test "*Customize Apropos*"
+ (customize-apropos "cus-edit-tests")
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
+ (with-cus-edit-test "*Customize Changed Options*"
+ (customize-changed-options "917.2") ; some future version
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
+ "Check that obsolete variables do not show up."
+ (with-cus-edit-test "*Customize Group: Cus Edit Tests*"
+ (customize-group 'cus-edit-tests)
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-option/show-obsolete ()
+ (with-cus-edit-test "*Customize Option: Cus Edit Tests Obsolete Option Tag*"
+ (customize-option 'cus-edit-tests--obsolete-option-tag)
+ (goto-char (point-min))
+ (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-saved/show-obsolete ()
+ (with-cus-edit-test "*Customize Saved*"
+ (cl-letf (((get 'cus-edit-tests--obsolete-option-tag 'saved-value) '(t)))
+ (customize-saved)
+ (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))))
+
+(provide 'cus-edit-tests)
+;;; cus-edit-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 13cbedf..680aa51 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -516,19 +516,25 @@ Subtests signal errors if something goes wrong."
;; Should not warn that mt--test2 is not known to be defined.
(should-not (re-search-forward "my--test2" nil t))))
+(defmacro bytecomp--with-warning-test (re-warning &rest form)
+ (declare (indent 1))
+ `(with-current-buffer (get-buffer-create "*Compile-Log*")
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (byte-compile ,@form)
+ (ert-info ((buffer-string) :prefix "buffer: ")
+ (should (re-search-forward ,re-warning)))))
+
(ert-deftest bytecomp-warn-wrong-args ()
- (with-current-buffer (get-buffer-create "*Compile-Log*")
- (let ((inhibit-read-only t)) (erase-buffer))
- (byte-compile '(remq 1 2 3))
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward "remq.*3.*2")))))
+ (bytecomp--with-warning-test "remq.*3.*2"
+ '(remq 1 2 3)))
(ert-deftest bytecomp-warn-wrong-args-subr ()
- (with-current-buffer (get-buffer-create "*Compile-Log*")
- (let ((inhibit-read-only t)) (erase-buffer))
- (byte-compile '(safe-length 1 2 3))
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward "safe-length.*3.*1")))))
+ (bytecomp--with-warning-test "safe-length.*3.*1"
+ '(safe-length 1 2 3)))
+
+(ert-deftest bytecomp-warn-variable-lacks-prefix ()
+ (bytecomp--with-warning-test "foo.*lacks a prefix"
+ '(defvar foo nil)))
(ert-deftest test-eager-load-macro-expansion ()
(test-byte-comp-compile-and-load nil
@@ -810,6 +816,12 @@ literals (Bug#20852)."
(test-suppression
'(defun zot ()
+ (next-line))
+ '((interactive-only next-line))
+ "interactive use only")
+
+ (test-suppression
+ '(defun zot ()
(mapcar #'list '(1 2 3))
nil)
'((mapcar mapcar))
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 42be029..49cb40b 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -392,6 +392,12 @@ C-b undefined
(define-key global-map (kbd "C-c C-l r") nil)
(define-key global-map (kbd "C-c C-l") nil)))
+(ert-deftest help-substitute-command-keys/preserves-text-properties ()
+ "Check that we preserve text properties (Bug#17052)."
+ (should (equal (substitute-command-keys
+ (propertize "foo \\[save-buffer]" 'face 'bold))
+ (propertize "foo C-x C-s" 'face 'bold))))
+
(provide 'help-tests)
;;; help-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
new file mode 100644
index 0000000..a02ea29
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
@@ -0,0 +1,16 @@
+sub interesting {
+ $_ = shift;
+ return
+ />Today is .+\'s birthday\.</
+ || / like[ds]? your post in </
+ || /like[ds] your new subscription\. </
+ || / likes? that you're interested in </
+ || /> likes? your comment: /
+ || /&birthdays=.*birthdays?\.<\/a>/;
+}
+
+sub boring {
+ return
+ / likes? your post in </
+ || / likes? that you're interested in </
+}
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index a0dd391..896160bb 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -228,6 +228,21 @@ documentation it does the right thing anyway."
(cperl-indent-command)
(forward-line 1))))
+(ert-deftest cperl-test-bug-28650 ()
+ "Verify that regular expressions are recognized after 'return'.
+The test uses the syntax property \"inside a string\" for the
+text in regular expressions, which is non-nil for both cperl-mode
+and perl-mode."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-26850.pl"))
+ (goto-char (point-min))
+ (re-search-forward "sub interesting {[^}]*}")
+ (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "Today"))
+ nil))
+ (re-search-forward "sub boring {[^}]*}")
+ (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "likes\\?"))
+ nil))))
+
(ert-deftest cperl-test-bug-30393 ()
"Verify that indentation is not disturbed by an open paren in col 0.
Perl is not Lisp: An open paren in column 0 does not start a function."
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 5451a79..3de1551 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -3153,13 +3153,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index ab2111e..ddb8d19 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -3726,13 +3726,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index e53fb96..40be768 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -3560,13 +3560,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 5a4b5b4..15f67c5 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -3317,13 +3317,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index f89cfef..583de5c 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 0a31ed0..86df93a 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl
index c378153..f055be1 100644
--- a/test/manual/indent/tcl.tcl
+++ b/test/manual/indent/tcl.tcl
@@ -20,3 +20,7 @@ proc foo3 {} {
puts a""b"; # And that won't either!
puts "a""b"; # But this will!
}
+
+# FIXME: The [..] interpolation within "..." strings is not properly
+# handled by the current `syntax-propertize-function`!
+set a "Testing: [split "192.168.1.1/24" "/"] address";
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ed09203..1312683 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -345,6 +345,25 @@ comparing the subr with a much slower lisp implementation."
(setq-default binding-test-some-local 'new-default))
(should (eq binding-test-some-local 'some))))
+(ert-deftest data-tests--let-buffer-local ()
+ (let ((blvar (make-symbol "blvar")))
+ (set-default blvar nil)
+ (make-variable-buffer-local blvar)
+
+ (dolist (var (list blvar 'left-margin))
+ (let ((def (default-value var)))
+ (with-temp-buffer
+ (should (equal def (symbol-value var)))
+ (cl-progv (list var) (list 42)
+ (should (equal (symbol-value var) 42))
+ (should (equal (default-value var) (symbol-value var)))
+ (set var 123)
+ (should (equal (symbol-value var) 123))
+ (should (equal (default-value var) (symbol-value var)))) ;bug#44733
+ (should (equal (symbol-value var) def))
+ (should (equal (default-value var) (symbol-value var))))
+ (should (equal (default-value var) def))))))
+
(ert-deftest binding-test-makunbound ()
"Tests of makunbound, from the manual."
(with-current-buffer binding-test-buffer-B
@@ -381,6 +400,37 @@ comparing the subr with a much slower lisp implementation."
"Test setting a keyword to itself"
(with-no-warnings (should (setq :keyword :keyword))))
+(ert-deftest data-tests--set-default-per-buffer ()
+ :expected-result t ;; Not fixed yet!
+ ;; FIXME: Performance tests are inherently unreliable.
+ ;; Using wall-clock time makes it even worse, so don't bother unless
+ ;; we have the primitive to measure cpu-time.
+ (skip-unless (fboundp 'current-cpu-time))
+ ;; Test performance of set-default on DEFVAR_PER_BUFFER variables.
+ ;; More specifically, test the problem seen in bug#41029 where setting
+ ;; the default value of a variable takes time proportional to the
+ ;; number of buffers.
+ (let* ((fun #'error)
+ (test (lambda ()
+ (with-temp-buffer
+ (let ((st (car (current-cpu-time))))
+ (dotimes (_ 1000)
+ (let ((case-fold-search 'data-test))
+ ;; Use an indirection through a mutable var
+ ;; to try and make sure the byte-compiler
+ ;; doesn't optimize away the let bindings.
+ (funcall fun)))
+ ;; FIXME: Handle the wraparound, if any.
+ (- (car (current-cpu-time)) st)))))
+ (_ (setq fun #'ignore))
+ (time1 (funcall test))
+ (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
+ (make-list 1000 nil)))
+ (time2 (funcall test)))
+ (mapc #'kill-buffer bufs)
+ ;; Don't divide one time by the other since they may be 0.
+ (should (< time2 (* time1 5)))))
+
;; More tests to write -
;; kill-local-variable
;; defconst; can modify
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d3c22f9..86b8d65 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -938,6 +938,13 @@
(should (equal (string-search "\303" "aøb") nil))
(should (equal (string-search "\270" "aøb") nil))
(should (equal (string-search "ø" "\303\270") nil))
+ (should (equal (string-search "ø" (make-string 32 ?a)) nil))
+ (should (equal (string-search "ø" (string-to-multibyte (make-string 32 ?a)))
+ nil))
+ (should (equal (string-search "o" (string-to-multibyte
+ (apply #'string
+ (number-sequence ?a ?z))))
+ 14))
(should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2))
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index e3dd842..6411cd1 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -54,6 +54,15 @@
(ert-deftest keymap-copy-keymap/is-not-eq ()
(should-not (eq (copy-keymap help-mode-map) help-mode-map)))
+(ert-deftest keymap---get-keyelt/runs-menu-item-filter ()
+ (let* (menu-item-filter-ran
+ (object `(menu-item "2" identity
+ :filter ,(lambda (cmd)
+ (setq menu-item-filter-ran t)
+ cmd))))
+ (keymap--get-keyelt object t)
+ (should menu-item-filter-ran)))
+
(ert-deftest keymap-lookup-key ()
(let ((map (make-keymap)))
(define-key map [?a] 'foo)
@@ -72,6 +81,26 @@ https://debbugs.gnu.org/39149#31";
(with-temp-buffer
(should (eq (describe-buffer-bindings (current-buffer)) nil))))
+(defun keymap-tests--test-menu-item-filter (show filter-fun)
+ (unwind-protect
+ (progn
+ (define-key global-map (kbd "C-c C-l r")
+ `(menu-item "2" identity :filter ,filter-fun))
+ (with-temp-buffer
+ (describe-buffer-bindings (current-buffer))
+ (goto-char (point-min))
+ (if (eq show 'show)
+ (should (search-forward "C-c C-l r" nil t))
+ (should-not (search-forward "C-c C-l r" nil t)))))
+ (define-key global-map (kbd "C-c C-l r") nil)
+ (define-key global-map (kbd "C-c C-l") nil)))
+
+(ert-deftest describe-buffer-bindings/menu-item-filter-show-binding ()
+ (keymap-tests--test-menu-item-filter 'show (lambda (cmd) cmd)))
+
+(ert-deftest describe-buffer-bindings/menu-item-filter-hide-binding ()
+ (keymap-tests--test-menu-item-filter 'hide (lambda (_) nil)))
+
(ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters ()
"Check for bug fixed in \"Fix assertion violation in define-key\",
commit 86c19714b097aa477d339ed99ffb5136c755a046."
@@ -170,6 +199,58 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(where-is-internal 'execute-extended-command global-map t))
[#x8000078])))
+
+;;;; describe_vector
+
+(ert-deftest help--describe-vector/bug-9293-one-shadowed-in-range ()
+ "Check that we only show a range if shadowed by the same command."
+ (let ((orig-map (let ((map (make-keymap)))
+ (define-key map "e" 'foo)
+ (define-key map "f" 'foo)
+ (define-key map "g" 'foo)
+ (define-key map "h" 'foo)
+ map))
+ (shadow-map (let ((map (make-keymap)))
+ (define-key map "f" 'bar)
+ map))
+ (text-quoting-style 'grave))
+ (with-temp-buffer
+ (help--describe-vector (cadr orig-map) nil #'help--describe-command
+ t shadow-map orig-map t)
+ (should (equal (buffer-string)
+ "
+e foo
+f foo (currently shadowed by `bar')
+g .. h foo
+")))))
+
+(ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow ()
+ "Check that a command can't be shadowed by the same command."
+ (let ((range-map
+ (let ((map (make-keymap)))
+ (define-key map "0" 'foo)
+ (define-key map "1" 'foo)
+ (define-key map "2" 'foo)
+ (define-key map "3" 'foo)
+ map))
+ (shadow-map
+ (let ((map (make-keymap)))
+ (define-key map "0" 'foo)
+ (define-key map "1" 'foo)
+ (define-key map "2" 'foo)
+ (define-key map "3" 'foo)
+ map)))
+ (with-temp-buffer
+ (help--describe-vector (cadr range-map) nil #'help--describe-command
+ t shadow-map range-map t)
+ (should (equal (buffer-string)
+ "
+0 .. 3 foo
+")))))
+
+
+;;;; apropos-internal
+
(ert-deftest keymap-apropos-internal ()
(should (equal (apropos-internal "^next-line$") '(next-line)))
(should (>= (length (apropos-internal "^help")) 100))
diff --git a/test/src/syntax-resources/syntax-comments.txt
b/test/src/syntax-resources/syntax-comments.txt
index 6f595e4..a292d81 100644
--- a/test/src/syntax-resources/syntax-comments.txt
+++ b/test/src/syntax-resources/syntax-comments.txt
@@ -62,7 +62,33 @@
33; \
33
+/* Lisp comments within lists */
+40)40
+41(;90 comment
+91)41
+42(;92\
+93)42
+43( ;94
+95
+
+/* Nested Lisp comments */
+100|#100
+101#|#
+102#||#102
+103#| Comment |#103
+104#| Comment
+|#104
+105#|#|#105
+106#| #| Comment |# |#106
+107#|#|#|#|#|#|#|#|#| Comment |#|#|#|#|#|#|#|#|#107
+
+/* Mixed Lisp comments */
+110; #|
+110
+111#| ; |#111
+
Local Variables:
mode: fundamental
eval: (set-syntax-table (make-syntax-table))
End:
+999
\ No newline at end of file
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 4b9c3f2..edee01e 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -220,7 +220,7 @@ missing or nil, the value of -START- is assumed for it."
(cond
((eq -dir- 'forward) t)
((eq -dir- 'backward) nil)
- (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'"
-dir-))))
+ (t (error "Invalid -dir- argument \"%s\" to `syntax-br-comments'"
-dir-))))
(start -start-)
(start-str (format "%d" (abs start)))
(type -type-))
@@ -338,10 +338,14 @@ the `parse-partial-sexp's are expected to stop. See
(setq parse-sexp-ignore-comments t)
(setq comment-end-can-be-escaped nil)
(modify-syntax-entry ?\n ">")
- (modify-syntax-entry ?\; "<"))
+ (modify-syntax-entry ?\; "<")
+ (modify-syntax-entry ?{ ".")
+ (modify-syntax-entry ?} "."))
(defun \;-out ()
(modify-syntax-entry ?\n " ")
- (modify-syntax-entry ?\; "."))
+ (modify-syntax-entry ?\; ".")
+ (modify-syntax-entry ?{ "(}")
+ (modify-syntax-entry ?} "){"))
(eval-and-compile
(setq syntax-comments-section "lisp"))
@@ -353,6 +357,62 @@ the `parse-partial-sexp's are expected to stop. See
(syntax-comments \; forward t 33)
(syntax-comments \; backward t 33)
+;; "Lisp" style comments inside lists.
+(syntax-br-comments \; backward nil 40)
+(syntax-br-comments \; forward t 41)
+(syntax-br-comments \; backward t 41)
+(syntax-br-comments \; forward t 42)
+(syntax-br-comments \; backward t 42)
+(syntax-br-comments \; forward nil 43)
+
+;; "Lisp" style comments parsed by `parse-partial-sexp'.
+(syntax-pps-comments \; 41 90 91)
+(syntax-pps-comments \; 42 92 93)
+(syntax-pps-comments \; 43 94 95 -999)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Lisp" style nested comments: between delimiters #| |#.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun \#|-in ()
+ (setq parse-sexp-ignore-comments t)
+ (modify-syntax-entry ?# ". 14")
+ (modify-syntax-entry ?| ". 23n")
+ (modify-syntax-entry ?\; "< b")
+ (modify-syntax-entry ?\n "> b"))
+(defun \#|-out ()
+ (modify-syntax-entry ?# ".")
+ (modify-syntax-entry ?| ".")
+ (modify-syntax-entry ?\; ".")
+ (modify-syntax-entry ?\n " "))
+(eval-and-compile
+ (setq syntax-comments-section "lisp-n"))
+
+(syntax-comments \#| forward nil 100 0)
+(syntax-comments \#| backward nil 100 0)
+(syntax-comments \#| forward nil 101 -999)
+(syntax-comments \#| forward t 102)
+(syntax-comments \#| backward t 102)
+
+(syntax-comments \#| forward t 103)
+(syntax-comments \#| backward t 103)
+(syntax-comments \#| forward t 104)
+(syntax-comments \#| backward t 104)
+
+(syntax-comments \#| forward nil 105 -999)
+(syntax-comments \#| backward t 105)
+(syntax-comments \#| forward t 106)
+(syntax-comments \#| backward t 106)
+(syntax-comments \#| forward t 107)
+(syntax-comments \#| backward t 107)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mixed "Lisp" style (nested and unnested) comments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(syntax-comments \#| forward t 110)
+(syntax-comments \#| backward t 110)
+(syntax-comments \#| forward t 111)
+(syntax-comments \#| backward t 111)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;