From b697bb91a1334e70bd7c8364e5ff6505b0edb21a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 13 Nov 2020 17:02:54 -0800 Subject: [PATCH 01/88] ; * .gitignore: src/fingerprint.c not generated since 2019-04-09. --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index 014970f96b2..1271dec0df7 100644 --- a/.gitignore +++ b/.gitignore @@ -188,7 +188,6 @@ src/bootstrap-emacs src/emacs src/emacs-[0-9]* src/temacs -src/fingerprint.c src/dmpstruct.h src/*.pdmp From daff3bda10d15fe20f5f6e9c5f5ca60b97cf80df Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Nov 2020 13:43:16 +0200 Subject: [PATCH 02/88] Avoid crashes when a reversed glyph row starts with a composition * src/dispnew.c (build_frame_matrix_from_leaf_window): Add an assertion to prevent us from overwriting non-char glyphs with the vertical border glyph. * src/xdisp.c (extend_face_to_end_of_line): Account for one glyph possibly inserted by append_space_for_newline. (Bug#44506) Remove a kludgey correction for an off-by-one error in column counting, which is no longer needed. --- src/dispnew.c | 10 +++++++--- src/xdisp.c | 15 ++++++++------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/dispnew.c b/src/dispnew.c index df55b32c718..7822829d648 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -2559,11 +2559,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/xdisp.c b/src/xdisp.c index 71a5f1c34f0..681df093418 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22074,13 +22074,14 @@ 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; + 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]; + do { if (it->current_x != indicator_column) From 5aabf2cc7f90a168fda694c6c5360f1df398255c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Nov 2020 13:56:12 +0200 Subject: [PATCH 03/88] Fix display of truncated R2L lines on TTY frames * src/xdisp.c (extend_face_to_end_of_line): Use a while-loop, not a do-while loop, to avoid appending an extra glyph at the end of a line that is one character shorter than the window-width. This is needed to fix display of reversed glyph rows that are almost as wide as the window, because append_space_for_newline already added one space glyph. --- src/xdisp.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 681df093418..c9175a68a02 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22082,7 +22082,7 @@ extend_face_to_end_of_line (struct it *it) updating current_x. */ it->current_x = it->glyph_row->used[TEXT_AREA]; - do + while (it->current_x <= it->last_visible_x) { if (it->current_x != indicator_column) PRODUCE_GLYPHS (it); @@ -22100,7 +22100,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] From 19da602991538e03648a82214cbb1bcc9a6ec14a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Nov 2020 15:20:30 +0200 Subject: [PATCH 04/88] Fix input method translation near read-only text * lisp/international/quail.el (quail-input-method): Don't disable input method when the character after point has the read-only property. Suggested by Evgeny Zajcev (Bug#44466) * doc/emacs/mule.texi (Input Methods): Document that input methods are inhibited in read-only text. --- doc/emacs/mule.texi | 6 ++++++ lisp/international/quail.el | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 0f07d286cda..3421ce66904 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/lisp/international/quail.el b/lisp/international/quail.el index 3299cc55a28..63371bce4fb 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 From e2c7b6372d220d09f5d1bf80aa353979a546c57c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 7 Nov 2020 12:29:41 +0200 Subject: [PATCH 05/88] Don't leave lock files after 'replace-buffer-contents' * src/editfns.c (Freplace_buffer_contents): Unlock the buffer's file if no changes have been made. (Bug#44303) (cherry picked from commit a5867ddfbd721568005175bf6c725f7834b21ea4) --- src/editfns.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/editfns.c b/src/editfns.c index f660513b2a4..fb420dac7fa 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2145,6 +2145,13 @@ nil. */) { signal_after_change (BEGV, size_a, ZV - BEGV); update_compositions (BEGV, ZV, CHECK_INSIDE); + /* We've locked the buffer's file above in + prepare_to_modify_buffer; if the buffer is unchanged at this + point, i.e. no insertions or deletions have been made, unlock + the file now. */ + if (SAVE_MODIFF == MODIFF + && STRINGP (BVAR (a, file_truename))) + unlock_file (BVAR (a, file_truename)); } return Qt; From d875a22bc6bebb1e45dd39c451fef4e264fca4e3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Nov 2020 15:55:35 +0200 Subject: [PATCH 06/88] Update the various INSTALL files * nt/INSTALL.W64: * nt/INSTALL: * INSTALL: Update the installation information, in particular the fact that HarfBuzz is now preferred as the shaping library. --- INSTALL | 34 ++++++++++++++++++++-------------- nt/INSTALL | 18 ++++++++++++++++++ nt/INSTALL.W64 | 12 +++++++----- 3 files changed, 45 insertions(+), 19 deletions(-) diff --git a/INSTALL b/INSTALL index 4d65f302aac..cb1fe8d3c2c 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 . +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 @@ -234,10 +240,10 @@ directory. On Red Hat-based systems, the corresponding command is config-manager --set-enabled fedora-debuginfo updates-debuginfo'). Once you have installed the source package, for example at -/path/to/emacs-26.1, add the following line to your startup file: +/path/to/emacs-27.1, add the following line to your startup file: (setq find-function-C-source-directory - "/path/to/emacs-26.1/src") + "/path/to/emacs-27.1/src") The installation directory of the Emacs source package will contain the exact package name and version number Emacs is installed on your @@ -249,7 +255,7 @@ Emacs debugging symbols are distributed by a debug package. It does not exist for every released Emacs package, this depends on the distribution. On Debian-based systems, you can install a debug package of Emacs with a command like 'apt-get install emacs-dbg' (on -older systems, replace 'emacs' with eg 'emacs25'). On Red Hat-based +older systems, replace 'emacs' with eg 'emacs27'). On Red Hat-based systems, the corresponding command is 'dnf debuginfo-install emacs'. diff --git a/nt/INSTALL b/nt/INSTALL index 2fe2c8c2673..27fb5f096f7 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 c3d4dfa4c28..498fc38f612 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. From 03eeab469ed829b4f06d970034ef1bbce01fea6e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Nov 2020 15:59:31 +0200 Subject: [PATCH 07/88] ; Update the expected result files in test/manual/etags. --- 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 +++++++------- 6 files changed, 42 insertions(+), 42 deletions(-) diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 5451a79efaa..3de15514e79 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 ab2111eafb2..ddb8d19540b 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 e53fb9629c5..40be768aacb 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 5a4b5b4b8ba..15f67c5d28a 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 f89cfefc388..583de5cbe22 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 0a31ed078e8..86df93afab1 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 From ab417cf64d15fb6f6620b45e31c249baec49f3a8 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 14 Nov 2020 13:19:47 -0800 Subject: [PATCH 08/88] Handle negation of search keys in gnus-search minibuffer completion * lisp/gnus/gnus-search.el (gnus-search-get-active): Keys might start with a leading "-": check for that and ignore it. --- lisp/gnus/gnus-search.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 17f1108029c..498da200dab 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")))) From f08e6538dca6d9cd1457ba1129afe1e56ee286f4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 15 Nov 2020 00:53:32 +0100 Subject: [PATCH 09/88] Run menu-item :filter function before showing binding * lisp/help.el (describe-map): Fix running `menu-item' :filter functions. This fixes a mistake in the previous conversion of this defun from the old C function describe_map. See the discussion in Bug#39149. * test/src/keymap-tests.el (keymap---get-keyelt/runs-menu-item-filter) (describe-buffer-bindings/menu-item-filter-show-binding) (describe-buffer-bindings/menu-item-filter-hide-binding): New tests. (keymap-tests--test-menu-item-filter): New defun. --- lisp/help.el | 1 + test/src/keymap-tests.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+) diff --git a/lisp/help.el b/lisp/help.el index 32ee84b5f92..ac5c2f1311b 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/test/src/keymap-tests.el b/test/src/keymap-tests.el index e3dd8420d7b..610234c5a13 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -54,6 +54,16 @@ (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) + (message "foo") + (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 +82,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." From 36431e16799872e84161d46e66057b05289a1335 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 15 Nov 2020 02:41:36 +0100 Subject: [PATCH 10/88] Make initial frame match frame-title-format * src/xterm.c (x_term_init): * src/w32term.c (w32_initialize_display_info): Sync initial frame title with new value of Vframe_title_format. Problem reported by Angelo Graziosi . --- src/w32term.c | 16 +++++++++++----- src/xterm.c | 24 ++++++++++++++---------- 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/src/w32term.c b/src/w32term.c index e0618e4f52d..23cb380040b 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/xterm.c b/src/xterm.c index 98bb0ea8917..0d2452de929 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); From 66bcec8838ab05b5690d7f530851ecf594c5d877 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 15 Nov 2020 10:34:54 +0000 Subject: [PATCH 11/88] * lisp/progmodes/cc-langs.el (c-<>-notable-chars-re): Fix wrong '-' in regexp --- lisp/progmodes/cc-langs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 0a7f4565c0e..56c3a4889b2 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3643,7 +3643,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)) From 4ec740866a65761fa1318400f299b2d591b05acf Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 15 Nov 2020 13:23:15 +0000 Subject: [PATCH 12/88] Make the invocation of combine-change-calls in comment-region valid This fixes bug #44581. The problem was that whitespace outside of the (BEG END) region was being deleted, and this made the invocation of combine-change-calls with (BEG END) invalid. * lisp/newcomment.el (comment-region-default): Amend the second argument to combine-change-calls. --- lisp/newcomment.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index e111ae8e225..3eb158dc2c8 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 From 4ddc38fc59845f7fa088121f435f62d1c0295c69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 15 Nov 2020 17:54:41 +0100 Subject: [PATCH 13/88] Reformat comment for 'gnu' compilation rule * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): The comments above the regexp for the 'gnu' rule contained references to the previous string regexp, which has been difficult to follow ever since the translation to rx. Move the comments to their proper places, and add some guiding notes. --- lisp/progmodes/compile.el | 67 ++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e0dabed6a7a..de9c9a209d1 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)) From 286c63277287a52148d8b9a8b57979d1d04d2ed0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 15 Nov 2020 19:26:38 +0200 Subject: [PATCH 14/88] Reformat argument commentary in etags.c * lib-src/etags.c (pfnote, consider_token, C_entries): Resurrect original format of comments to function arguments. --- lib-src/etags.c | 36 ++++++++++++++++-------------------- 1 file changed, 16 insertions(+), 20 deletions(-) diff --git a/lib-src/etags.c b/lib-src/etags.c index 8babe926db1..f761a7b7c33 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1973,14 +1973,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; @@ -2904,15 +2903,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 @@ -3311,9 +3308,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' */ From 81588748bd85827468e297d3e44a72844438e807 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 15 Nov 2020 22:32:39 +0200 Subject: [PATCH 15/88] New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay' * lisp/emacs-lisp/lisp.el (delete-pair-blink-delay): New defcustom. (delete-pair): Use it. (Bug#4136) * lisp/simple.el (copy-region-blink-delay): New defcustom. (indicate-copied-region): Use it. (Bug#42865) Thanks to Sean Whitton . (indicate-copied-region): Use 'query-replace-descr' not to show newlines literally. Use "Copied text" instead of misleading "Saved text" (bug#42865). --- etc/NEWS | 6 ++++++ lisp/emacs-lisp/lisp.el | 16 +++++++++++++++- lisp/simple.el | 36 +++++++++++++++++++++++++----------- 3 files changed, 46 insertions(+), 12 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7aa54882508..90e4d292bac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -203,6 +203,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 diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 35590123ee6..124900168c3 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/simple.el b/lisp/simple.el index e96c7c9a6ea..5158bc74a9c 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. From 53e2a612ad7441ac24d27872d404f6f0f15a3962 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 15 Nov 2020 15:08:58 -0800 Subject: [PATCH 16/88] ; * lib-src/make-fingerprint.c: Update commentary. --- lib-src/make-fingerprint.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index c013d0aca3b..b72ee90bbca 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 . */ -/* 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 From 75723ec212ca0ac0b5f019622960caf083e95105 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 16 Nov 2020 12:48:54 +0100 Subject: [PATCH 17/88] ; * lisp/emacs-lisp/benchmark.el (benchmark-run): Fix docstring --- lisp/emacs-lisp/benchmark.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index a7fcc5cb8f2..ee0774db23a 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 From 238261db95ae3e99907594e839fd30ec5476762b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 16 Nov 2020 14:43:55 +0100 Subject: [PATCH 18/88] Don't quote lambdas in eshell/*.el * lisp/eshell/em-basic.el (eshell-echo): * lisp/eshell/em-cmpl.el (eshell-command-completion-function) (eshell-default-completion-function, eshell-cmpl-initialize) (eshell-complete-parse-arguments, eshell-complete-commands-list): * lisp/eshell/em-dirs.el (eshell-complete-user-reference): * lisp/eshell/em-hist.el (eshell-hist-unload-hook) (eshell-hist-initialize): * lisp/eshell/em-ls.el (eshell-ls-sort-entries): * lisp/eshell/em-pred.el (eshell-modifier-alist) (eshell-display-predicate-help, eshell-display-modifier-help) (eshell-pred-substitute, eshell-split-members): * lisp/eshell/em-prompt.el (eshell-prompt-function): * lisp/eshell/em-smart.el (eshell-smart-unload-hook) (eshell-smart-initialize, eshell-refresh-windows): * lisp/eshell/em-unix.el (eshell-shuffle-files): * lisp/eshell/esh-arg.el (eshell-parse-argument-hook): * lisp/eshell/esh-cmd.el (eshell-cmd-initialize) (eshell-parse-command): * lisp/eshell/esh-mode.el (eshell-preinput-scroll-to-bottom) (eshell-postoutput-scroll-to-bottom): * lisp/eshell/esh-module.el (eshell-modules-list): * lisp/eshell/esh-proc.el (eshell-read-process-name) (eshell-round-robin-kill): * lisp/eshell/esh-var.el (eshell-envvar-names) (eshell-variables-list): Don't quote lambdas. --- 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 | 73 +++++++++++++++++------------------- 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 | 30 +++++++-------- lisp/eshell/esh-mode.el | 58 ++++++++++++++-------------- lisp/eshell/esh-module.el | 19 +++++----- lisp/eshell/esh-proc.el | 10 ++--- lisp/eshell/esh-var.el | 20 +++++----- 15 files changed, 212 insertions(+), 246 deletions(-) diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 6cfc89cce62..e54eab50fc9 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 8a444c91001..53a0cda354e 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 51df6fa1d52..b4ed3794add 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 bdc21c916c6..c27e4503767 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 c1a022ee521..e10be8e6232 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -631,38 +631,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 +798,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 +844,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 59139da10db..7b9503917c4 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 9ae5ae12816..dcee1e7a981 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 f173c8db9c1..a28bb1d6415 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 937b8bfa391..18818648bc4 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 e7b07b4208d..aefda647689 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 e0348ba5013..f1cf9336899 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 diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index e0e86348bd8..a80c2fc60d9 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 45c4c9e13c0..10994ba3010 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 db1b258c8f5..4a1001bf058 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 7388279f157..f91fb89412e 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) From 82d0b88720b1d2b0449e42ae2e9e7994fd4a5e8f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 16 Nov 2020 16:53:24 +0100 Subject: [PATCH 19/88] Don't quote lambdas in calc/calcalg{2,3}.el * lisp/calc/calcalg2.el (calcFunc-inv\', calcFunc-sqrt\') (calcFunc-deg\', calcFunc-rad\', calcFunc-ln\') (calcFunc-log10\', calcFunc-lnp1\', calcFunc-log\') (calcFunc-log\'2, calcFunc-exp\', calcFunc-expm1\') (calcFunc-sin\', calcFunc-cos\', calcFunc-tan\', calcFunc-sec\') (calcFunc-csc\', calcFunc-cot\', calcFunc-arcsin\') (calcFunc-arccos\', calcFunc-arctan\', calcFunc-sinh\') (calcFunc-cosh\', calcFunc-tanh\', calcFunc-sech\') (calcFunc-csch\', calcFunc-coth\', calcFunc-arcsinh\') (calcFunc-arccosh\', calcFunc-arctanh\', calcFunc-bern\'2) (calcFunc-euler\'2, calcFunc-gammag\'2, calcFunc-gammaG\'2) (calcFunc-gammaP\'2, calcFunc-gammaQ\'2, calcFunc-betaB\') (calcFunc-betaI\', calcFunc-erf\', calcFunc-erfc\') (calcFunc-besJ\'2, calcFunc-besY\'2, calcFunc-sum) (calcFunc-prod, calcFunc-integ, calcFunc-if, calcFunc-subscr) (math-do-integral, calcFunc-integ, math-decompose-poly) (math-solve-system-rec, math-solve-system-subst, math-solve-for) (calcFunc-inv, calcFunc-sqrt, calcFunc-conj, calcFunc-abs) (calcFunc-deg, calcFunc-rad, calcFunc-ln, calcFunc-log10) (calcFunc-lnp1, calcFunc-exp, calcFunc-expm1, calcFunc-sin) (calcFunc-cos, calcFunc-tan, calcFunc-arcsin, calcFunc-arccos) (calcFunc-arctan, calcFunc-sinh, calcFunc-cosh, calcFunc-tanh) (calcFunc-arcsinh, calcFunc-arccosh, calcFunc-arctanh): * lisp/calc/calcalg3.el (calc-get-fit-variables) (calcFunc-polint, calcFunc-ratint, math-all-vars-but): Don't quote lambdas. --- lisp/calc/calcalg2.el | 583 +++++++++++++++++++++--------------------- lisp/calc/calcalg3.el | 16 +- 2 files changed, 294 insertions(+), 305 deletions(-) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 7894bd93015..bf4d6261910 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 f1f67211b84..fdcde95dae7 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 From f0f2c8563b3f57be4c6b174b49fbac1e530ef7ac Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 16 Nov 2020 17:03:45 +0100 Subject: [PATCH 20/88] Don't quote lambdas in emacs-lisp/*.el * lisp/emacs-lisp/cl-seq.el (cl--parsing-keywords, cl-sort): * lisp/emacs-lisp/cl-macs.el (cl-typecase): * lisp/emacs-lisp/cl-extra.el (cl-some, cl-every) (cl--map-keymap-recursively): * lisp/emacs-lisp/advice.el (ad-insert-argument-access-forms): * lisp/emacs-lisp/edebug.el (edebug-sort-alist) (edebug-set-windows): * lisp/emacs-lisp/pp.el (pp-display-expression): * lisp/emacs-lisp/regi.el (regi-interpret): Don't quote lambdas. --- lisp/emacs-lisp/advice.el | 42 ++++++++++++++++++------------------- lisp/emacs-lisp/cl-extra.el | 29 +++++++++++++------------ lisp/emacs-lisp/cl-macs.el | 26 +++++++++++------------ lisp/emacs-lisp/cl-seq.el | 13 ++++++------ lisp/emacs-lisp/edebug.el | 20 ++++++++---------- lisp/emacs-lisp/pp.el | 40 +++++++++++++++++------------------ lisp/emacs-lisp/regi.el | 21 ++++++++----------- 7 files changed, 89 insertions(+), 102 deletions(-) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 5cda399b5ef..bb45bb37d11 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2370,28 +2370,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/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index d3159a37683..a55d78de153 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 1501ed43082..14b65ef25bf 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 @@ -2763,7 +2762,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))) @@ -2790,9 +2789,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 d34d50172df..8cfdd140f8e 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/edebug.el b/lisp/emacs-lisp/edebug.el index e310313940f..f242e922bde 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/pp.el b/lisp/emacs-lisp/pp.el index eb2ee94be3b..458f803ffe3 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 11b28b72cf3..2e6e2b75d6a 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 From 9191c82f6d69340ce231a41c61594e1b9b9b51aa Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 16 Nov 2020 18:52:42 +0100 Subject: [PATCH 21/88] Don't quote lambdas in net/*.el * lisp/net/eudc-export.el (eudc-create-bbdb-record): * lisp/net/eudc.el (eudc-print-attribute-value) (eudc-display-records, eudc-process-form) (eudc-filter-duplicate-attributes, eudc-filter-partial-records) (eudc-add-field-to-records, eudc-query-with-words) (eudc-query-form, eudc-menu): * lisp/net/eudcb-bbdb.el (eudc-bbdb-extract-phones) (eudc-bbdb-query-internal): * lisp/net/mairix.el (mairix-widget-make-query-from-widgets) (mairix-widget-build-editable-fields, mairix-widget-get-values): Don't quote lambdas. --- lisp/net/eudc-export.el | 11 +- lisp/net/eudc.el | 237 +++++++++++++++++++--------------------- lisp/net/eudcb-bbdb.el | 43 ++++---- lisp/net/mairix.el | 83 +++++++------- 4 files changed, 176 insertions(+), 198 deletions(-) diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index ba86958142c..5c966281499 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 08cab4f0470..f4e4c17d69e 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 82e58c28336..5d6b52a19d2 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 8218249ec18..5571b2ab81c 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")))) From 7dd671f7f2755dad7df81640dfee0abf135095ea Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 15 Nov 2020 20:12:45 +0100 Subject: [PATCH 22/88] Use lexical-binding in time-stamp.el * lisp/time-stamp.el: Use lexical-binding. Remove redundant :group args. --- lisp/time-stamp.el | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 7c64f2903be..c50d68b60af 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) From 29eff32307494eabed5c0160ad1713d832e65f74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Francesco=20Potort=C3=AC?= Date: Mon, 16 Nov 2020 22:36:05 +0100 Subject: [PATCH 23/88] Add new user option bibtex-unify-case-convert * lisp/textmodes/bibtex.el (bibtex-unify-case-convert): New variable (bug#44614). (bibtex-format-entry): Use it (bug#44614). --- etc/NEWS | 5 +++ lisp/textmodes/bibtex.el | 89 +++++++++++++++++++++++----------------- 2 files changed, 56 insertions(+), 38 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 90e4d292bac..79c937b9aea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1307,6 +1307,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 diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index fcf63ed5ecf..b69d715faa7 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -88,6 +88,17 @@ 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. +This variable is buffer-local." + :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"))) +(make-variable-buffer-local 'bibtex-unify-case-convert) + (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) "List of optional fields the user wants to have always present. @@ -122,7 +133,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 +2358,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 +2561,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) From 7ab6213886c72ac7a04a20b114a4f810c6484168 Mon Sep 17 00:00:00 2001 From: Ruthra Kumar Date: Mon, 16 Nov 2020 23:04:36 +0100 Subject: [PATCH 24/88] Use 'eshell-find-alias-function' instead of fboundp * lisp/eshell/esh-cmd.el (eshell-invoke-directly): Fix problem with (require 'em-tramp) making password prompting from "sudo bash" no longer work (bug#43772). --- lisp/eshell/esh-cmd.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index f1cf9336899..68b34837a23 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -918,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." From fd43ecd96e5abff02101d4a7ed8507dd7b296542 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Nov 2020 23:16:39 +0100 Subject: [PATCH 25/88] Fix gnus-mime-display-alternative button natigation * lisp/gnus/gnus-art.el (gnus-mime-display-alternative): Mark the buttons correctly so that TAB can find them (bug#44690). --- lisp/gnus/gnus-art.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1efc1d6f7d9..8f4ca7eb3b9 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 " ")) From b4b3eb8b8095e64efdd0452f653da70ea70d730c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Nov 2020 23:54:02 +0100 Subject: [PATCH 26/88] Make the handwrite.el PS valid again MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/play/handwrite.el (handwrite): Make the PS valid (bug#44648). Suggested by Omar Antolín . --- lisp/play/handwrite.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 1cf690a86db..06ea54cb473 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 From b613f25f97abf756101eaa2af90689a19c0b3350 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Nov 2020 00:18:11 +0100 Subject: [PATCH 27/88] Minor Edebug manual keystroke clarifications * doc/lispref/edebug.texi (Edebug Misc): Also mention the `a' binding to abort (bug#44697). Also fix `d' function reference, and add `P' reference. --- doc/lispref/edebug.texi | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 6e9ec47f7b0..820fdb9bea0 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. From f5f9e100972598b1bb9cea4c0445777db2e1131e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Tue, 17 Nov 2020 00:20:26 +0100 Subject: [PATCH 28/88] perl-mode and cperl-mode: Recognize regex after "return" * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Add "return" to the keywords which start a regex. * lisp/progmodes/perl-mode.el (defconst): Add "return" to 'perl--syntax-exp-intro-keywords' (Bug#26850). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-28650): New test (bug#26850). --- lisp/progmodes/cperl-mode.el | 2 +- lisp/progmodes/perl-mode.el | 2 +- .../cperl-mode-resources/cperl-bug-26850.pl | 16 ++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 15 +++++++++++++++ 4 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a42ace105aa..0dc45515d41 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3959,7 +3959,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)) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 7265aeee45d..bb19436cdad 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/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 00000000000..a02ea29fe9d --- /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\. likes? your comment: / + || /&birthdays=.*birthdays?\.<\/a>/; +} + +sub boring { + return + / likes? your post in Date: Mon, 16 Nov 2020 23:16:23 +0000 Subject: [PATCH 29/88] ; Fix last change to bibtex.el * lisp/textmodes/bibtex.el (bibtex-unify-case-convert): Clarify docstring and remove leading asterisk. Use defcustom :local tag. --- lisp/textmodes/bibtex.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index b69d715faa7..d53cfa0b1ff 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -88,16 +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. -This variable is buffer-local." +(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"))) -(make-variable-buffer-local 'bibtex-unify-case-convert) + (function :tag "Conversion function")) + :local t) (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) From 27655f9f38ab8037b599ce20341662d767fdc58c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 02:17:14 +0100 Subject: [PATCH 30/88] Test that substitute-command-keys preserves text properties * test/lisp/help-tests.el (help-substitute-command-keys/preserves-text-properties): New test. (Bug#17052) --- test/lisp/help-tests.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 42be0296c4f..49cb40b29d9 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 From 3626c9ae83689abd7452a07925919196f985f144 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 03:10:12 +0100 Subject: [PATCH 31/88] Don't quote lambdas with function macro in generic-x.el * lisp/generic-x.el (apache-conf-generic-mode, ini-generic-mode) (reg-generic-mode, mailagent-rules-generic-mode) (vrml-generic-mode, java-properties-generic-mode) (alias-generic-mode, ansible-inventory-generic-mode) (inetd-conf-generic-mode, etc-services-generic-mode) (etc-passwd-generic-mode, etc-fstab-generic-mode) (spice-generic-mode, astap-generic-mode): Don't quote lambdas with function macro. --- lisp/generic-x.el | 119 ++++++++++++++++++++-------------------------- 1 file changed, 52 insertions(+), 67 deletions(-) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 48ac1232051..b56b63132d2 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -280,12 +280,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-*]+\\)>" 1) - ("*Locations*" "^\\s-*]+\\)>" 1)))))) + (lambda () + (setq imenu-generic-expression + '((nil "^\\([-A-Za-z0-9_]+\\)" 1) + ("*Directories*" "^\\s-*]+\\)>" 1) + ("*Locations*" "^\\s-*]+\\)>" 1))))) "Generic mode for Apache or HTTPD configuration files.")) (when (memq 'apache-log-generic-mode generic-extras-enable-list) @@ -401,11 +400,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 +430,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 +453,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 +544,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 +589,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 +615,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 +637,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 +1423,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 +1440,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 +1482,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 +1535,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 +1697,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 +1744,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) From 0a7ec10ac621c210fbf87e4465cb05e378b79889 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 12:13:13 +0100 Subject: [PATCH 32/88] Add command to filter package menu by name or description * lisp/emacs-lisp/package.el (package-menu-filter-by-description): (package-menu-filter-by-name-or-description): New commands to filter the package menu. (Bug#44699) (package-menu-mode-map): Bind the above new commands. (package-menu-mode-menu): Add new commands to the menu. * doc/emacs/package.texi (Package Menu): Document new commands. --- doc/emacs/package.texi | 16 ++++++++++++++ etc/NEWS | 4 +++- lisp/emacs-lisp/package.el | 43 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 62 insertions(+), 1 deletion(-) diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 56e8ee1363a..4981dd50c75 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/etc/NEWS b/etc/NEWS index 79c937b9aea..9f39851b4a5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -831,12 +831,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 diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fbab6debd5d..d78a1a2856a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2704,7 +2704,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) @@ -2736,8 +2738,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"] @@ -3765,6 +3770,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. @@ -3790,6 +3812,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. From 030ad21afecdd718ce741cff9666c1913a8211df Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 02:51:30 +0100 Subject: [PATCH 33/88] Don't quote lambdas with 'function' in calc/*.el * lisp/calc/calc-aent.el (calc-do-quick-calc) (calc-do-calc-eval, math-build-parse-table): * lisp/calc/calc-alg.el (math-polynomial-base): * lisp/calc/calc-alg.el (math-is-poly-rec): * lisp/calc/calc-arith.el (calcFunc-scf): * lisp/calc/calc-arith.el (math-ceiling, math-round): * lisp/calc/calc-arith.el (math-trunc-fancy, math-floor-fancy): * lisp/calc/calc-ext.el (calc-init-extensions, calc-reset) (calc-refresh-top, calc-z-prefix-help, calc-binary-op-fancy) (calc-unary-op-fancy): * lisp/calc/calc-forms.el (math-make-mod): * lisp/calc/calc-frac.el (calcFunc-frac): * lisp/calc/calc-funcs.el (calcFunc-euler): * lisp/calc/calc-help.el (calc-full-help): * lisp/calc/calc-lang.el (c, pascal, fortran, tex, latex, eqn) (yacas, maxima, giac, math, maple): * lisp/calc/calc-macs.el (calc-wrapper, calc-slow-wrapper): * lisp/calc/calc-map.el (calc-get-operator, calcFunc-mapeqr) (calcFunc-reducea, calcFunc-rreducea, calcFunc-reduced) (calcFunc-rreduced, calcFunc-outer): * lisp/calc/calc-misc.el (another-calc, calc-do-handle-whys): * lisp/calc/calc-mode.el (calc-save-modes): * lisp/calc/calc-mtx.el (math-col-matrix, math-mul-mat-vec): * lisp/calc/calc-poly.el (math-sort-terms, math-poly-div-list) (math-mul-list, math-sort-poly-base-list) (math-partial-fractions): * lisp/calc/calc-prog.el (calc-user-define-formula): * lisp/calc/calc-rewr.el (math-rewrite, math-compile-patterns) (math-compile-rewrites, math-parse-schedule) (math-rwcomp-pattern): * lisp/calc/calc-store.el (calc-var-name-map, calc-let) (calc-permanent-variable, calc-insert-variables): * lisp/calc/calc-stuff.el (calc-flush-caches, calcFunc-pclean) (calcFunc-pfrac): * lisp/calc/calc-units.el (math-build-units-table) (math-decompose-units): * lisp/calc/calc-vec.el (calcFunc-mrow, math-mat-col) (calcFunc-mcol, math-mat-less-col, math-mimic-ident): * lisp/calc/calc-yank.el (calc-edit): * lisp/calc/calc.el (calc-mode-var-list-restore-default-values) (calc-mode-var-list-restore-saved-values, calc-mode, calc-quit): * lisp/calc/calccomp.el (math-compose-expr) (math-compose-matrix, math-vector-to-string): Don't quote lambdas with 'function'. --- 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 | 362 +++++++++++++++++++--------------------- 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/calccomp.el | 117 +++++++------ 24 files changed, 467 insertions(+), 507 deletions(-) diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 6c162b55f7b..338f0ea43e0 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 efb68395f7e..53ca01d9516 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 ae397c4f2c4..c11cecfd545 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 23248ce1bd5..4877fa6e08c 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 465d4520b05..39116bfde99 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 86a4808c5ad..1d6895caa3a 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 5c179ff05d4..9ee86e755ea 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 0b327e8d0f6..06b4b9684e3 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 bde5abe649f..283069446e0 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 )}")) + (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))))) + ((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 5aaa5f48d6c..06ef3ef0556 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 0ee82826927..3e2869d146a 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 2db09e2b677..ada754a3979 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 e109233a825..358854bc93c 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 8deef7dc4fd..bfcd61ddcd4 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 b3f2c96b0ca..5928a8ee47c 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 ea9c49748e2..781ba5c8b66 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 2cc7b6beef0..1528e12ae0e 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 a1e385cb406..8f83f34d748 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 58b81faee50..8df2ed905aa 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 709c09ea099..742b2bb8728 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 875414595cf..036f08e276d 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 e03c00243c4..6186df718db 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 5716189b342..9d869f359bc 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/calccomp.el b/lisp/calc/calccomp.el index 1f3ae842638..e4f6e989ecf 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) From ab9a23e029ce1507d9e863e086db8796d727d1a4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 17 Nov 2020 16:51:49 +0000 Subject: [PATCH 34/88] Enhance syntax-tests.el to test nestable comments (Lisp style) Also add some tests for braces and parse-partial-sexp amongst Lisp style comments. * test/src/syntax-tests.el (\;-in, \;-out): Add syntax for { and }. (top-level): Add new tests for Lisp style comments. (\#|-in, \#|-out): New functions. (top-level): Add new tests for nested Lisp style comments, and mixtures of nested comments with "ordinary" comments. * test/src/syntax-resources/syntax-comments.txt (top-level): Add new test fragments for #|...|#, etc. --- test/src/syntax-resources/syntax-comments.txt | 26 ++++++++ test/src/syntax-tests.el | 66 ++++++++++++++++++- 2 files changed, 89 insertions(+), 3 deletions(-) diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt index 6f595e4d8dc..a292d816b9d 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 4b9c3f277aa..edee01ec585 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 68e57e0046328aa47ffad721718749b0991f6591 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 03:13:50 +0100 Subject: [PATCH 35/88] Remove redundant 'function's around lambdas in mh/*.el * lisp/mh-e/mh-alias.el (mh-alias-tstamp, mh-alias-filenames) (mh-alias-address-to-alias): * lisp/mh-e/mh-comp.el (mh-edit-again, mh-redistribute): * lisp/mh-e/mh-identity.el (mh-identity-make-menu): * lisp/mh-e/mh-utils.el (mh-help): Remove redundant 'function's around lambdas. --- 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 +- 4 files changed, 73 insertions(+), 80 deletions(-) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index cc437c3c49b..d037bdce887 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 8a69adbb756..e766bca89d8 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 ebc7d2a4fcb..ed239963391 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 44b4ef48795..28d3c7614ce 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 From 43ad3c175d2e289f42be861eac5da807d6b1e088 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 17 Nov 2020 18:42:38 +0100 Subject: [PATCH 36/88] Remove redundant 'function's around lambdas * lisp/allout.el (allout-latex-verb-quote): * lisp/edmacro.el (edmacro-format-keys): * lisp/ffap.el (ffap-all-subdirs-loop) (ffap-kpathsea-expand-path, ffap-menu-rescan): * lisp/files.el (save-buffers-kill-emacs): * lisp/find-lisp.el (find-lisp-find-dired-internal) (find-lisp-insert-directory): * lisp/gnus/gnus-agent.el (gnus-agent-expire-unagentized-dirs): * lisp/gnus/nnmairix.el (nnmairix-create-message-line-for-search) (nnmairix-widget-get-values) (nnmairix-widget-make-query-from-widgets) (nnmairix-widget-build-editable-fields): * lisp/international/mule-cmds.el (sort-coding-systems): * lisp/international/mule-diag.el (list-character-sets-1): * lisp/international/quail.el (quail-insert-decode-map): * lisp/mail/reporter.el (reporter-dump-state): * lisp/mail/supercite.el (sc-attribs-filter-namelist): * lisp/pcmpl-gnu.el (pcmpl-gnu-zipped-files) (pcmpl-gnu-bzipped-files): * lisp/progmodes/cperl-mode.el (cperl-find-tags) (cperl-write-tags, cperl-tags-hier-init, cperl-tags-treeify) (cperl-menu-to-keymap, cperl-pod-spell): * lisp/progmodes/gdb-mi.el (gdb-parent-mode): * lisp/progmodes/make-mode.el (makefile-browser-fill): * lisp/simple.el (transpose-lines): * lisp/term.el: * lisp/term/w32-win.el (w32-find-non-USB-fonts): * lisp/textmodes/table.el (table--generate-source-scan-lines): Remove redundant 'function's around lambdas. --- lisp/allout.el | 11 ++- lisp/edmacro.el | 51 ++++++----- lisp/ffap.el | 30 +++---- lisp/files.el | 6 +- lisp/find-lisp.el | 24 +++--- lisp/gnus/gnus-agent.el | 31 ++++--- lisp/gnus/nnmairix.el | 84 +++++++++---------- lisp/international/mule-cmds.el | 99 +++++++++++----------- lisp/international/mule-diag.el | 13 ++- lisp/international/quail.el | 15 ++-- lisp/mail/reporter.el | 14 ++-- lisp/mail/supercite.el | 21 +++-- lisp/pcmpl-gnu.el | 30 ++++--- lisp/progmodes/cperl-mode.el | 144 +++++++++++++++----------------- lisp/progmodes/gdb-mi.el | 21 +++-- lisp/progmodes/make-mode.el | 6 +- lisp/simple.el | 23 +++-- lisp/term.el | 13 ++- lisp/term/w32-win.el | 79 +++++++++--------- lisp/textmodes/table.el | 55 ++++++------ 20 files changed, 366 insertions(+), 404 deletions(-) diff --git a/lisp/allout.el b/lisp/allout.el index b56071de59e..a4802a1c2a6 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/edmacro.el b/lisp/edmacro.el index 1d9b4726b04..44cf5aad387 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/ffap.el b/lisp/ffap.el index bf035886006..9ad421c2777 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -690,14 +690,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 +709,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) @@ -1793,8 +1791,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 +1799,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'): diff --git a/lisp/files.el b/lisp/files.el index deb878cf418..3565b7f5710 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7370,9 +7370,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/find-lisp.el b/lisp/find-lisp.el index 352720412a5..c1be5ff403d 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/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 76c2904eaf0..053e7ea1f6b 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/nnmairix.el b/lisp/gnus/nnmairix.el index dcecfcf6519..e53e000beae 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/international/mule-cmds.el b/lisp/international/mule-cmds.el index 1e6fea8578c..d361971a1fc 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 b13bde58ca1..57e568689e3 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 e94b42230be..39ef6d3bf01 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2478,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/mail/reporter.el b/lisp/mail/reporter.el index 0c8b8d47a08..805dd12d3bd 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 986d0cf4074..b2ccd3d9934 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1028,17 +1028,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/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index fa84b31675e..c6050094498 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/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 0dc45515d41..3606f9a3952 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5442,11 +5442,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 +6072,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 +6525,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 @@ -6645,16 +6642,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 +6764,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 +6811,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 +6897,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 +8232,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 6e9b6830a01..0023e1fb5d0 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1617,17 +1617,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 diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 8596d78a604..3e49f84dbce 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/simple.el b/lisp/simple.el index 5158bc74a9c..bb28145502b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7435,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/term.el b/lisp/term.el index 8cbbfff1b63..585232be6c3 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 e866fdc36ce..7a15537186d 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -567,46 +567,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/table.el b/lisp/textmodes/table.el index 25aa58046f4..065fdd09ccb 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)) From 827786cf759a0a14c3e2ebea2963478c2f1a9b5c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 18 Nov 2020 11:32:38 +0100 Subject: [PATCH 37/88] Preserve `dired-filename' text properties in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Restore `dired-filename' text property, which has been destroyed by `decode-coding-region'. (Bug#44682) --- lisp/net/tramp-sh.el | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ccf0c0d0e28..c4390b3d041 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2658,7 +2658,8 @@ The method used must be an out-of-band method." #'file-name-nondirectory (list localname))))))) (save-restriction - (let ((beg (point))) + (let ((beg (point)) + match) (narrow-to-region (point) (point)) ;; We cannot use `insert-buffer-substring' because the Tramp ;; buffer changes its contents before insertion due to calling @@ -2696,10 +2697,25 @@ The method used must be an out-of-band method." (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)) + ;; Decode the output, it could be multibyte. We must + ;; restore the text property, because `decode-coding-region' + ;; has destroyed it. However, text-property-search.el + ;; exists since Emacs 27 only. + (if (not (require 'text-property-search nil 'noerror)) + (decode-coding-region + beg (point-max) + (or file-name-coding-system default-file-name-coding-system)) + (goto-char beg) + (while (setq match + (tramp-compat-funcall + 'text-property-search-forward 'dired-filename t t)) + (decode-coding-region + (tramp-compat-funcall 'prop-match-beginning match) + (tramp-compat-funcall 'prop-match-end match) + (or file-name-coding-system default-file-name-coding-system)) + (put-text-property + (tramp-compat-funcall 'prop-match-beginning match) + (point) 'dired-filename t))) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) From 88d5b1d3253728bd314de36544996aa15345bd29 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 18 Nov 2020 11:47:54 +0000 Subject: [PATCH 38/88] Don't make bibtex-unify-case-convert buffer-local The :local tag does not currently work as intended (it results in a default value of bibtex-unify-case-convert of nil rather than identity), and no other bibtex.el user option is automatically buffer-local, so revert this recent change. For discussion, see the following emacs-devel thread: https://lists.gnu.org/r/emacs-devel/2020-11/msg00734.html * lisp/textmodes/bibtex.el (bibtex-unify-case-convert): Don't make automatically buffer-local for consistency with other user options, and because the :local tag doesn't have the intended results. --- lisp/textmodes/bibtex.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index d53cfa0b1ff..c9e21e58f62 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -96,8 +96,7 @@ It is called with one argument, the entry or field name." (const :tag "Downcase" downcase) (const :tag "Capitalize" capitalize) (const :tag "Upcase" upcase) - (function :tag "Conversion function")) - :local t) + (function :tag "Conversion function"))) (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) From d5ac6679df4925ef51cc0f299af2a84f27faafe7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 18 Nov 2020 10:55:41 +0100 Subject: [PATCH 39/88] Turn gdb-wait-for-pending into a plain function MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This avoids unnecessary body duplication in expansion and macro recursion (causing macro-expansions at runtime), making it clearer what is going on. * lisp/progmodes/gdb-mi.el (gdb-wait-for-pending): Make it a function, remove lambda quoting, η-reduce and simplify. (gdb-thread-exited, gdb-thread-selected): Adapt callers. --- lisp/progmodes/gdb-mi.el | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 0023e1fb5d0..903005610d7 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 @@ -2524,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. @@ -2538,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 From de7d9e1f88da08abf3883d585a69d52fbdd61963 Mon Sep 17 00:00:00 2001 From: Protesilaos Stavrou Date: Wed, 18 Nov 2020 23:14:39 +0200 Subject: [PATCH 40/88] Clarify that 'diff-error' is part of Emacs 28.1 * lisp/vc/diff-mode.el (diff-error): Add :version tag (bug#44727). --- lisp/vc/diff-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 5aeb8feb990..0a906136047 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) From ca8e37eaf64f23675fab36eadead4d3b613b8a1b Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sun, 15 Nov 2020 17:21:03 +0000 Subject: [PATCH 41/88] Fix SVG display again (bug#44655) * src/image.c (svg_load_image): Fall back to rsvg_handle_get_dimensions if we can't calculate the size of the image. --- src/image.c | 35 +++++++++++++---------------------- 1 file changed, 13 insertions(+), 22 deletions(-) diff --git a/src/image.c b/src/image.c index 3858f3c41f3..fdb7ef874d7 100644 --- a/src/image.c +++ b/src/image.c @@ -9903,30 +9903,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; -#endif 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; - } +#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; + + 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); From b5f3a04f47a7542a39b18bf6026cbb7f01cab5dd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 01:44:25 +0100 Subject: [PATCH 42/88] Make compat alias add-submenu obsolete * lisp/emacs-lisp/easymenu.el (add-submenu): Make compat alias obsolete. * lisp/filesets.el (filesets-build-menu-now): Don't use above obsolete alias. (filesets-menu-path, filesets-menu-before) (filesets-menu-in-menu): Doc fix. --- lisp/emacs-lisp/easymenu.el | 1 + lisp/filesets.el | 35 +++++++++++++++++------------------ 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 73dabef3fa5..b0198dbf8d5 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/filesets.el b/lisp/filesets.el index 2cad2023b85..dc813661470 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -308,7 +308,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 +317,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 +326,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) @@ -2349,21 +2349,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. From 0e075c9f913d6235637e080f71f59a26c5be6b7b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 02:39:09 +0100 Subject: [PATCH 43/88] Remove unnecessary load from idlwave * lisp/progmodes/idlw-shell.el: * lisp/progmodes/idlwave.el: Remove unnecessary load; easy-menu-define is autoloaded. --- lisp/progmodes/idlw-shell.el | 28 +++++++++++++--------------- lisp/progmodes/idlwave.el | 14 ++++++-------- 2 files changed, 19 insertions(+), 23 deletions(-) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 38127fccbc3..efc51ec32c3 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -4352,21 +4352,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 86f9f336723..1cb54d6324e 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -9032,14 +9032,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." From 7cda88250fb1ab370e12ad4e4db84a17559c6c91 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 02:54:26 +0100 Subject: [PATCH 44/88] * lisp/progmodes/cperl-mode.el: Doc fix. --- lisp/progmodes/cperl-mode.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3606f9a3952..3f24b10828c 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, From 51b9acbeccf2c62be02d1312d665ea4233d60922 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 02:56:34 +0100 Subject: [PATCH 45/88] Assume font-lock is provided; it's preloaded since 22.1 * lisp/cedet/semantic/format.el (semantic--format-colorize-text): * lisp/eshell/em-ls.el (eshell-ls--insert-directory): * lisp/net/dig.el (dig-mode): * lisp/progmodes/cperl-mode.el (cperl-pod-here-fontify): * lisp/progmodes/idlw-help.el (idlwave-help-fontify): * lisp/progmodes/idlwave.el (idlwave-completion-fontify-classes): Don't check for feature 'font-lock; it has been preloaded since 22.1. * lisp/cedet/semantic/format.el (font-lock): * lisp/epa.el (font-lock): * lisp/erc/erc.el (font-lock): * lisp/generic-x.el (font-lock): * lisp/net/sieve-mode.el (font-lock): * lisp/progmodes/prolog.el (font-lock): * lisp/textmodes/rst.el (font-lock): Remove unnecessary require. --- lisp/cedet/semantic/format.el | 11 ++++------- lisp/epa.el | 1 - lisp/erc/erc.el | 1 - lisp/eshell/em-ls.el | 3 +-- lisp/generic-x.el | 2 -- lisp/net/dig.el | 6 ++---- lisp/net/sieve-mode.el | 2 -- lisp/progmodes/cperl-mode.el | 2 +- lisp/progmodes/idlw-help.el | 21 ++++++++++----------- lisp/progmodes/idlwave.el | 15 +++++++-------- lisp/progmodes/prolog.el | 3 --- lisp/textmodes/rst.el | 2 -- 12 files changed, 25 insertions(+), 44 deletions(-) diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index bb2954be561..e972015c6bf 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/epa.el b/lisp/epa.el index 25e055c201f..4e288283d13 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) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e35ae0cfd87..bf7b16d448e 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) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index e10be8e6232..6b306f77874 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) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index b56b63132d2..5875dce5f03 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-" diff --git a/lisp/net/dig.el b/lisp/net/dig.el index f36999119f2..da4ea4050d8 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/sieve-mode.el b/lisp/net/sieve-mode.el index c5f44917919..05e9747e74d 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/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3f24b10828c..b7dc59bed9d 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -400,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) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 2d4ea465c42..89296ff5b50 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/idlwave.el b/lisp/progmodes/idlwave.el index 1cb54d6324e..5c1e82240cb 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -7642,14 +7642,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))) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 124f652ed69..75e95d9b904 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/textmodes/rst.el b/lisp/textmodes/rst.el index adda28cb81b..7a7ac478b76 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 From 4ee6fa279954f5b03d4e2ed935de8e14b7e8b6c9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 03:14:19 +0100 Subject: [PATCH 46/88] Declare XEmacs compat function in inversion.el obsolete * lisp/cedet/inversion.el (inversion-require-emacs): Declare obsolete. --- lisp/cedet/inversion.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el index d47701d5a8b..113f4056e2c 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) From b6d2ea05cc886298f68e47de009fcdf1a5140c59 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 06:12:25 +0100 Subject: [PATCH 47/88] Add new variable cperl-tags-file-name * lisp/progmodes/cperl-mode.el (cperl-tags-file-name): New variable. (cperl-write-tags): Use above new variable instead of hardcoding filename "TAGS". (Bug#8802) --- lisp/progmodes/cperl-mode.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index b7dc59bed9d..30a80ea8f22 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6602,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. @@ -6611,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) From cb2e34b49332cf2664de6fc4a8a79da5965298ed Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 06:34:11 +0100 Subject: [PATCH 48/88] Remove outdated comment about Emacs 20 from viper.el * lisp/emulation/viper-util.el (viper-chars-in-region): Remove outdated comment. --- lisp/emulation/viper-util.el | 8 -------- 1 file changed, 8 deletions(-) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 83e45e1cd0c..9da493d74ba 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) From 6e469709c550ba18d9d5a34f6bb89908472f0eb2 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 19 Nov 2020 10:31:50 +0000 Subject: [PATCH 49/88] In attempted recursive minibuffer use, display error message in correct frame This was problematic when minibuffer-follows-selected-frame was non-nil. Introduce a new parameter DONT-SET-FRAME to set-window-configuration. * doc/lispref/windows.texi (Window Configurations): Describe the new &optional parameter to set-window-configuration. * etc/NEWS (Lisp Changes): Note the new parameter to set-window-configuration. * src/keyboard.c (read_char_help_form_unwind): Add a new Qnil argument to the call of Fset_window_configuration. * src/minibuf.c (read_minibuf): Cons up a Qt with the window configuration in the argument to record_unwind_protect for the window configuration (twice). * src/window.c (Fset_window_configuration): Add the new &optional parameter and document it in the doc string. At the final do_switch_frame operation, restore the original frame when DONT-SET-FRAME is non-nil. (restore_window_configuration): Handle the new parameter when the supplied argument is a cons. --- doc/lispref/windows.texi | 7 +++++-- etc/NEWS | 45 +++++----------------------------------- src/keyboard.c | 2 +- src/minibuf.c | 5 +++-- src/window.c | 21 ++++++++++++++----- 5 files changed, 30 insertions(+), 50 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 5ec23a9c876..2d092e1842a 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 9f39851b4a5..ee9f484be35 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -203,12 +203,6 @@ 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 @@ -441,11 +435,6 @@ their 'default-directory' under VC. *** New command 'vc-dir-root' uses the root directory without asking. ---- -*** New face 'log-view-commit-body'. -This is used when expanding commit messages from 'vc-print-root-log' -and similar commands. - --- *** The responsible VC backend is now the most specific one. 'vc-responsible-backend' loops over the backends in @@ -669,13 +658,6 @@ to the search string. --- *** New input method 'compose' based on X Multi_key sequences. ---- -*** New input method 'iso-transl' with the same keys as 'C-x 8'. -After selecting it as a transient input method with 'C-u C-x \ -iso-transl RET', it supports the same key sequences as 'C-x 8', -so e.g. like 'C-x 8 [' inserts a left single quotation mark, -'C-x \ [' does the same. - --- *** Improved language transliteration in Malayalam input methods. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now @@ -1142,13 +1124,6 @@ project's root directory, respectively. +++ *** New user option 'project-list-file'. -** xref - ---- -*** 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 --- @@ -1265,11 +1240,6 @@ and the result is not truncated in any way. *** The '/' operator now has higher precedence in (La)TeX input mode. It no longer has lower precedence than '+' and '-'. ---- -*** Calc now marks its windows dedicated. -The new user option 'calc-make-windows-dedicated' controls this. It -is t by default; set to nil to get back the old behavior. - ** term-mode --- @@ -1346,11 +1316,6 @@ visited errors, so you can have an overview what errors were already visited. If 'tab-always-indent' is 'complete', this new user option can be used to further tweak whether to complete or indent. ---- -*** 'dired-query' now uses 'read-char-from-minibuffer'. -Using it instead of 'read-char-choice' allows using 'C-x o' -to switch to the help window displayed after typing 'C-h'. - --- *** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. This allows navigating through the history of characters that have @@ -1758,6 +1723,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 ++++ +** '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 @@ -1999,11 +1969,6 @@ image API via 'M-x report-emacs-bug'. --- ** The user option 'make-pointer-invisible' is now honored on macOS. --- -** On macOS, 's-' and 's-' are now bound to -'move-beginning-of-line' and 'move-end-of-line' respectively. The commands -to select previous/next frame are still bound to 's-~' and 's-`'. - ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/src/keyboard.c b/src/keyboard.c index 49a0a8bd236..1579c007ecf 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 \ diff --git a/src/minibuf.c b/src/minibuf.c index c4adca15365..464e3018f7d 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/window.c b/src/window.c index a6de34f3db6..6cd3122b43b 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); } From 74a35d16e25bdb07d847b980008fc4d25ab9404e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 19 Nov 2020 13:24:28 +0000 Subject: [PATCH 50/88] * etc/NEWS: Restore entries accidentally removed by previous commit. --- etc/NEWS | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index ee9f484be35..a0e72bc673b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -203,6 +203,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 @@ -435,6 +441,11 @@ their 'default-directory' under VC. *** New command 'vc-dir-root' uses the root directory without asking. +--- +*** New face 'log-view-commit-body'. +This is used when expanding commit messages from 'vc-print-root-log' +and similar commands. + --- *** The responsible VC backend is now the most specific one. 'vc-responsible-backend' loops over the backends in @@ -658,6 +669,13 @@ to the search string. --- *** New input method 'compose' based on X Multi_key sequences. +--- +*** New input method 'iso-transl' with the same keys as 'C-x 8'. +After selecting it as a transient input method with 'C-u C-x \ +iso-transl RET', it supports the same key sequences as 'C-x 8', +so e.g. like 'C-x 8 [' inserts a left single quotation mark, +'C-x \ [' does the same. + --- *** Improved language transliteration in Malayalam input methods. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now @@ -1124,6 +1142,13 @@ project's root directory, respectively. +++ *** New user option 'project-list-file'. +** xref + +--- +*** 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 --- @@ -1240,6 +1265,11 @@ and the result is not truncated in any way. *** The '/' operator now has higher precedence in (La)TeX input mode. It no longer has lower precedence than '+' and '-'. +--- +*** Calc now marks its windows dedicated. +The new user option 'calc-make-windows-dedicated' controls this. It +is t by default; set to nil to get back the old behavior. + ** term-mode --- @@ -1316,6 +1346,11 @@ visited errors, so you can have an overview what errors were already visited. If 'tab-always-indent' is 'complete', this new user option can be used to further tweak whether to complete or indent. +--- +*** 'dired-query' now uses 'read-char-from-minibuffer'. +Using it instead of 'read-char-choice' allows using 'C-x o' +to switch to the help window displayed after typing 'C-h'. + --- *** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. This allows navigating through the history of characters that have @@ -1969,6 +2004,11 @@ image API via 'M-x report-emacs-bug'. --- ** The user option 'make-pointer-invisible' is now honored on macOS. +-- +** On macOS, 's-' and 's-' are now bound to +'move-beginning-of-line' and 'move-end-of-line' respectively. The commands +to select previous/next frame are still bound to 's-~' and 's-`'. + ---------------------------------------------------------------------- This file is part of GNU Emacs. From 90aab73f8d6b5fd0a8adb706c8ae669564f23c56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 19 Nov 2020 14:24:24 +0100 Subject: [PATCH 51/88] More string-search optimisations All-ASCII strings cannot have substrings with non-ASCII characters in them; use this fact to avoid searching entirely. * src/fns.c (Fstring_search): For multibyte non-ASCII needle and unibyte haystack, don't check if the haystack is all-ASCII; it's a waste of time. For multibyte non-ASCII needle and multibyte all-ASCII haystack, fail immediately. * test/src/fns-tests.el (string-search): Add more test cases. --- src/fns.c | 23 +++++++++++++++-------- test/src/fns-tests.el | 7 +++++++ 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/fns.c b/src/fns.c index f50bf8ecb77..e4c9acc3163 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/test/src/fns-tests.el b/test/src/fns-tests.el index d3c22f966e6..86b8d655d26 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)) From 4fa1de82a28b04128fcb02b3dd1bfcca34efda4c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 19 Nov 2020 17:18:36 +0100 Subject: [PATCH 52/88] Use decoding implementation from `insert-directory' in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Use decoding implementation from `insert-directory', it is more robust. --- lisp/net/tramp-sh.el | 63 ++++++++++++++++++++++++++------------------ 1 file changed, 38 insertions(+), 25 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c4390b3d041..f9b218a970a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2658,8 +2658,7 @@ The method used must be an out-of-band method." #'file-name-nondirectory (list localname))))))) (save-restriction - (let ((beg (point)) - match) + (let ((beg (point))) (narrow-to-region (point) (point)) ;; We cannot use `insert-buffer-substring' because the Tramp ;; buffer changes its contents before insertion due to calling @@ -2692,30 +2691,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 ""))) + (save-excursion + (goto-char beg) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "")))) - ;; Decode the output, it could be multibyte. We must - ;; restore the text property, because `decode-coding-region' - ;; has destroyed it. However, text-property-search.el - ;; exists since Emacs 27 only. - (if (not (require 'text-property-search nil 'noerror)) - (decode-coding-region - beg (point-max) - (or file-name-coding-system default-file-name-coding-system)) - (goto-char beg) - (while (setq match - (tramp-compat-funcall - 'text-property-search-forward 'dired-filename t t)) - (decode-coding-region - (tramp-compat-funcall 'prop-match-beginning match) - (tramp-compat-funcall 'prop-match-end match) - (or file-name-coding-system default-file-name-coding-system)) - (put-text-property - (tramp-compat-funcall 'prop-match-beginning match) - (point) 'dired-filename t))) + ;; 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)) From 3963aea4f4a22da0c1fb8ca8ca80b59c58373811 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 19 Nov 2020 13:10:20 -0500 Subject: [PATCH 53/88] * src/buffer.h (struct buffer): Remove unused field `minor_modes` * src/buffer.c (bset_minor_modes): Remove function. (reset_buffer_local_variables, init_buffer_once): Don't set `minor_modes`. --- src/buffer.c | 7 ------- src/buffer.h | 3 --- 2 files changed, 10 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 4fd2b0c8b17..360dd348e05 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 3da49414bb8..fe549c5dac1 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_; From 75555b5b6bc517911404fc769b02f583e40f6c35 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 06:42:46 +0100 Subject: [PATCH 54/88] Remove some compat code for old versions and XEmacs * lisp/ibuf-ext.el (ibuffer-old-saved-filters-warning) (ibuffer-maybe-save-stuff): Assume customize-save-variable is bound; it is autoloaded. * lisp/cedet/semantic/symref/grep.el (semantic-symref-perform-search): * lisp/password-cache.el (password-cache-remove): * lisp/cedet/semantic/bovine/el.el (semantic-dependency-tag-file): Remove Emacs 21 compat code. * lisp/cedet/semantic/sort.el (semantic-string-lessp-ci): Remove Emacs 20 compat code. * test/lisp/cedet/semantic-utest.el (semantic-utest-temp-directory): * lisp/mail/supercite.el (sc-ask): Remove XEmacs compat code. * lisp/progmodes/idlw-shell.el (idlwave-shell-mode): * lisp/progmodes/idlwave.el (idlwave-mode): Remove commented out compat code. --- lisp/cedet/semantic/bovine/el.el | 26 +++++--------------------- lisp/cedet/semantic/sort.el | 6 +----- lisp/cedet/semantic/symref/grep.el | 22 ++++------------------ lisp/ibuf-ext.el | 19 +++++++------------ lisp/mail/supercite.el | 9 +-------- lisp/password-cache.el | 4 +--- lisp/progmodes/idlw-shell.el | 4 ---- lisp/progmodes/idlwave.el | 5 ----- test/lisp/cedet/semantic-utest.el | 7 +------ 9 files changed, 20 insertions(+), 82 deletions(-) diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index bbed1d94f20..2f05b99e467 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/sort.el b/lisp/cedet/semantic/sort.el index 89fc917e0c7..a565d878f15 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 d8de8ead4e9..29e88cda125 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/ibuf-ext.el b/lisp/ibuf-ext.el index 80c5b073985..79342976746 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/mail/supercite.el b/lisp/mail/supercite.el index b2ccd3d9934..9b7af0111e2 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) diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 2443f374a84..375d06c74fd 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/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index efc51ec32c3..155ab7ba4ca 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -967,8 +967,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 +1005,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? diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 5c1e82240cb..6dd8853b1a0 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -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) diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el index e537871528c..bcbd7d686e3 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 From 1ac6330fce34beaead60f1c5c7573950e9014780 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 17:41:18 +0100 Subject: [PATCH 55/88] Remove some compat code from url.el * lisp/url/url.el (url-warn): Make into obsolete alias for display-warning. * lisp/url/url-auth.el (url-register-auth-scheme): * lisp/url/url-news.el (url-news-open-host): * lisp/url/url-proxy.el (url-find-proxy-for-url): Adjust callers. --- lisp/url/url-auth.el | 3 +-- lisp/url/url-news.el | 3 +-- lisp/url/url-proxy.el | 3 +-- lisp/url/url.el | 14 +------------- 4 files changed, 4 insertions(+), 19 deletions(-) diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index fd800cd9782..bcb48aa455d 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-news.el b/lisp/url/url-news.el index 9ef17cccd77..78a6aa94839 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 9513c3973a1..698a87098ba 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 33a5ebcdccc..5188007a58b 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) From 493e19b97f8561638f042fb166cd69a384718edd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 17:42:14 +0100 Subject: [PATCH 56/88] Declare some compat aliases obsolete * lisp/cedet/semantic/tag.el (semantic-token-version) (semantic-token-incompatible-version): * lisp/emulation/edt.el (edt-bind-standard-key): Make compat aliases obsolete. --- lisp/cedet/semantic/tag.el | 10 +++++----- lisp/emulation/edt.el | 3 +-- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index e677264c5a9..badefd59e64 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1321,12 +1321,12 @@ 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 +;;; Obsolete ;; -(defconst semantic-token-version - semantic-tag-version) -(defconst semantic-token-incompatible-version - semantic-tag-incompatible-version) +(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") (provide 'semantic/tag) diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index e70b44658d5..b29ad7702ef 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 ." (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 standard key sequences to custom bindings in the EDT Emulator. From 842fc2d01ebf7ff2d41bce2d8a0b25c30d41941b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 17:46:16 +0100 Subject: [PATCH 57/88] Remove some compat code from ffap.el * lisp/ffap.el (ffap-mouse-event, ffap-event-buffer): Make obsolete. (ffap-menu-ask, ffap-at-mouse): Adjust callers. --- lisp/ffap.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/ffap.el b/lisp/ffap.el index 9ad421c2777..d4bddd0574f 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)))) @@ -1736,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 @@ -1829,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 From 70773e5b97e6952ad7650e6872855451c64325c0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Nov 2020 20:58:26 +0100 Subject: [PATCH 58/88] Remove some XEmacs compat code from filesets.el * lisp/filesets.el (filesets-init): Remove some XEmacs compat code. (filesets-error): Declare obsolete. (filesets-directory-files, filesets-get-selection) (filesets-spawn-external-viewer, filesets-get-filelist) (filesets-open, filesets-close, filesets-get-menu-epilog) (filesets-ingroup-collect-files, filesets-build-ingroup-submenu) (filesets-update-pre010505): Adjust callers. --- lisp/filesets.el | 43 ++++++++++++++++--------------------------- 1 file changed, 16 insertions(+), 27 deletions(-) diff --git a/lisp/filesets.el b/lisp/filesets.el index dc813661470..c7ec3f77f43 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -89,6 +89,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'easymenu) ;;; Some variables @@ -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) @@ -2473,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." @@ -2509,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)) @@ -2524,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) From 8fac2444641567b10f4c38b599636aeae0478e68 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 19 Nov 2020 17:13:04 -0500 Subject: [PATCH 59/88] * src/data.c (set_internal): Fix bug#44733 Set the default value when `set` encounters a PER_BUFFER variable which has been let-bound globally, to match the behavior seen with `make-variable-buffer-local`. * test/src/data-tests.el (binding-test--let-buffer-local): Add corresponding test. (data-tests--set-default-per-buffer): Add tentative test for the performance problem encountered in bug#41029. --- src/data.c | 10 +++++---- test/src/data-tests.el | 50 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/src/data.c b/src/data.c index 65589856687..5d4df1886d3 100644 --- a/src/data.c +++ b/src/data.c @@ -1440,10 +1440,12 @@ 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/test/src/data-tests.el b/test/src/data-tests.el index ed092039078..1312683c848 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 From bc951000b35fc48edfe1f643998d201b971f0d30 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 20 Nov 2020 00:19:18 +0100 Subject: [PATCH 60/88] Avoid a compilation warning about an ambiguous else MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/data.c (set_internal): Avoid compilation warning. data.c:1443:9: error: suggest explicit braces to avoid ambiguous ‘else’ 1443 | if (idx > 0 && bindflag == SET_INTERNAL_SET | ^ --- src/data.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/data.c b/src/data.c index 5d4df1886d3..384c2592204 100644 --- a/src/data.c +++ b/src/data.c @@ -1442,10 +1442,12 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, int idx = PER_BUFFER_IDX (offset); 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 (let_shadows_buffer_binding_p (sym)) + set_default_internal (symbol, newval, bindflag); + else + SET_PER_BUFFER_VALUE_P (buf, idx, 1); + } } if (voide) From 59b340c1e6c9fc8b30123fbfecd50f58adc3bf6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 20 Nov 2020 01:18:16 +0000 Subject: [PATCH 61/88] Fix default timeout handling in jsonrpc-request * lisp/jsonrpc.el (jsonrpc-request): Use default timeout if not passed. (Version): Bump to 1.0.13 --- lisp/jsonrpc.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 7de6baeb00a..d28cf7a91fa 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.12 +;; Version: 1.0.13 ;; 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,13 +301,14 @@ 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))))) + (t (while t (sit-for 30))))) ;; In normal operation, cancellation is handled by the ;; timeout function and response filter, but we still have ;; to protect against user-quit (C-g) or the From f6b26fa43f61404e306913f7216c105b44fdc4fe Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 20 Nov 2020 03:33:38 +0100 Subject: [PATCH 62/88] Move semantic/tag obsolete variables to avoid a warning * lisp/cedet/semantic/tag.el (semantic-token-version): Move to avoid a compilation warning. --- lisp/cedet/semantic/tag.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index badefd59e64..3dadf347736 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) "): "))) -;;; Obsolete -;; -(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") (provide 'semantic/tag) From e7791c7e57b4b9ea895598cdb3f779c2173dccd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A3vora?= Date: Fri, 20 Nov 2020 10:02:52 +0000 Subject: [PATCH 63/88] Revert unintended part of last change to jsonrpc-request While playing around with the timing in this function, I left this change that could freeze the function on some platforms. * lisp/jsonrpc.el (jsonrpc-request): Use accept-process-output. (Version): Bump to 1.0.14 --- lisp/jsonrpc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index d28cf7a91fa..0b3394080cc 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.13 +;; Version: 1.0.14 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -308,7 +308,7 @@ ignored." (let ((inhibit-quit t)) (while (sit-for 30))) (setq cancelled t)) `(cancelled ,cancel-on-input-retval)) - (t (while t (sit-for 30))))) + (t (while t (accept-process-output nil 30))))) ;; In normal operation, cancellation is handled by the ;; timeout function and response filter, but we still have ;; to protect against user-quit (C-g) or the From b4b1bd6e03d739871dd3ba51e8de0be2d272b766 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 14:33:25 +0100 Subject: [PATCH 64/88] Hide obsolete options in most customize commands * lisp/cus-edit.el (custom--filter-obsolete-variables): New defun. * lisp/cus-edit.el (customize-changed-options) (customize-apropos, custom-group-value-create): Hide obsolete user options. (Bug#44598) * test/lisp/cus-edit-tests.el: New file. --- etc/NEWS | 10 +++++ lisp/cus-edit.el | 26 ++++++++---- test/lisp/cus-edit-tests.el | 80 +++++++++++++++++++++++++++++++++++++ 3 files changed, 108 insertions(+), 8 deletions(-) create mode 100644 test/lisp/cus-edit-tests.el diff --git a/etc/NEWS b/etc/NEWS index a0e72bc673b..efec6743237 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -712,6 +712,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 +++ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d1077d367d5..b46be39e381 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1298,7 +1298,8 @@ that were added or redefined since that version." (if (custom-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)))) @@ -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)) diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el new file mode 100644 index 00000000000..4d148b4f411 --- /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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ert-x) +(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 () + ;; FIXME: How to test for saved options? + :expected-result :failed + (with-cus-edit-test "*Customize Saved*" + (customize-saved) + (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))) + +(provide 'cus-edit-tests) +;;; cus-edit-tests.el ends here From 88adf1f0dd82866a81fae3338adcda735a499a63 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 20 Nov 2020 17:00:36 +0200 Subject: [PATCH 65/88] Fix compilation on MS-Windows with librsvg > 2.46.0 * src/image.c (rsvg_handle_get_dimensions, init_svg_functions): Make 'rsvg_handle_get_dimensions' available and defined for all versions of librsvg. (Bug#44655) --- src/image.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/image.c b/src/image.c index fdb7ef874d7..5eb41322950 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 From 22d81123f5d552d516fb9461f90ad196af9c91a8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 14:56:49 +0100 Subject: [PATCH 66/88] Mark compat alias in cus-face.el obsolete * lisp/cus-face.el (custom-facep): Mark compat alias obsolete. * lisp/cus-dep.el (custom-make-dependencies): * lisp/cus-edit.el (customize-changed-options) (custom-unsaved-options, customize-saved, customize-apropos) (custom-save-faces): Adjust callers. --- lisp/cus-dep.el | 2 +- lisp/cus-edit.el | 10 +++++----- lisp/cus-face.el | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 9003b7fc1b5..db2c4446387 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -204,7 +204,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 b46be39e381..eceba8fa4d6 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1295,7 +1295,7 @@ 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--filter-obsolete-variables @@ -1406,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)) @@ -1453,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)) @@ -1491,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) @@ -4898,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 cc766aa4509..199a76e5cc8 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) From e8ee682733733e33336cb5983ef024c0830dbecc Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 14:57:22 +0100 Subject: [PATCH 67/88] Properly mark obsolete semantic functions as such * lisp/cedet/semantic/ia.el (semantic-ia-get-completions) (semantic-ia-get-completions-deprecated): Make obsolete. --- lisp/cedet/semantic/ia.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 4a129aae74e..e6711608386 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 From 8834776b140c7ffec127316e53b778c15550d5e3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 15:13:08 +0100 Subject: [PATCH 68/88] Remove Emacs 20 compat code from idlwave.el * lisp/progmodes/idlwave.el (idlwave-indent-line) (idlwave-toggle-comment-region, idlwave-reset-sintern) (idlwave-unit-name, idlwave-mode-menu-def) (idlwave-create-customize-menu): Remove Emacs 20 compat code. --- lisp/progmodes/idlwave.el | 57 +++++++++++++-------------------------- 1 file changed, 19 insertions(+), 38 deletions(-) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 6dd8853b1a0..44bdd918d6c 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -2776,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 @@ -3991,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))))) @@ -4042,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) @@ -8886,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 @@ -9004,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] @@ -9045,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'." From 430eb2f850b26f7df8473de4d929b5665673a0a2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 15:17:22 +0100 Subject: [PATCH 69/88] Remove Emacs 20 compat code from org.el * lisp/org/org.el (org-org-menu, org-create-customize-menu): Remove Emacs 20 compat code. --- lisp/org/org.el | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 1ab8ab68880..d2a36dd0bad 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 From c1269e711481290a52f0e316a194145b55f18ad8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 16:19:14 +0100 Subject: [PATCH 70/88] Remove some XEmacs compat code from ediff-wind.el * lisp/vc/ediff-wind.el (ediff-window) (ediff-compute-toolbar-width): Remove some XEmacs compat code. --- lisp/vc/ediff-wind.el | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index a23d72070ab..c68dc718843 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 From 8c801138acfb5b1068a78b1a10e055d2e7952c9e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 16:22:35 +0100 Subject: [PATCH 71/88] Remove XEmacs compat code from idlw-shell.el * lisp/progmodes/idlw-shell.el: (idlwave-shell-use-toolbar): Doc fix. (idlwave-default-mouse-track-event-is-with-button): Declare obsolete. (idlwave-shell-update-bp-overlays): Remove XEmacs compat code. --- lisp/progmodes/idlw-shell.el | 30 +++++------------------------- 1 file changed, 5 insertions(+), 25 deletions(-) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 155ab7ba4ca..70b94596e10 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) @@ -2747,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") @@ -3608,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 @@ -3619,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 From ea218f424ae3a016b439f2e2d2abe0a167bac78e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 16:43:57 +0100 Subject: [PATCH 72/88] Don't set XEmacs only properties start-open and end-open * lisp/epa.el (epa-sign-region, epa-encrypt-region): * lisp/erc/erc.el (erc-display-prompt): * lisp/gnus/message.el (message-forward-make-body-mime): * lisp/net/eudc-bob.el (eudc-bob-display-jpeg) (eudc-bob-display-audio, eudc-bob-display-generic-binary): * lisp/url/url-http.el (url-http-chunked-encoding-after-change-function): Don't set XEmacs only properties start-open and end-open. --- lisp/epa.el | 8 ++------ lisp/erc/erc.el | 3 +-- lisp/gnus/message.el | 2 +- lisp/net/eudc-bob.el | 12 +++--------- lisp/url/url-http.el | 4 +--- 5 files changed, 8 insertions(+), 21 deletions(-) diff --git a/lisp/epa.el b/lisp/epa.el index 4e288283d13..d6c7946c939 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -1070,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") @@ -1147,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.el b/lisp/erc/erc.el index bf7b16d448e..94ea0de7ee7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4014,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/gnus/message.el b/lisp/gnus/message.el index 0782778fd43..5bdf53763a2 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/net/eudc-bob.el b/lisp/net/eudc-bob.el index bb6682520ae..b2069ed6ef8 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/url/url-http.el b/lisp/url/url-http.el index 8532da1d1fb..75330d33277 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 From 966052cb5935208e14f29e297dd93d4ce640b005 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 16:44:52 +0100 Subject: [PATCH 73/88] Remove remaining XEmacs compat code from erc-log.el * lisp/erc/erc-log.el (erc-save-buffer-in-logs): Remove XEmacs compat code. --- lisp/erc/erc-log.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index de0a16ea3f0..7eddb5f60f1 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 From 86d87d24310f087fef99fa959156b024626bf2d2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 17:25:31 +0100 Subject: [PATCH 74/88] Don't quote lambda in idlwave.el * lisp/progmodes/idlwave.el (idlwave-keyword-abbrev): Don't quote lambda. --- lisp/progmodes/idlwave.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 44bdd918d6c..876c38da7e7 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 From 6924320aebce9ba885877da45e43d8d573da8bf6 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 20 Nov 2020 18:37:30 -0300 Subject: [PATCH 75/88] Take care of a FIXME in cus-edit-tests.el * test/lisp/cus-edit-tests.el (cus-edit-tests-customize-saved/show-obsolete): Add a fake saved-value property, to be able check that the obsolete option is present in the Customize buffer. Expect the test to pass now. --- test/lisp/cus-edit-tests.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 4d148b4f411..114e461b7ac 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -70,11 +70,13 @@ (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))) (ert-deftest cus-edit-tests-customize-saved/show-obsolete () - ;; FIXME: How to test for saved options? - :expected-result :failed (with-cus-edit-test "*Customize Saved*" - (customize-saved) - (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))) + (unwind-protect + (progn + (put 'cus-edit-tests--obsolete-option-tag 'saved-value '(t)) + (customize-saved) + (should (search-forward cus-edit-tests--obsolete-option-tag nil t))) + (put 'cus-edit-tests--obsolete-option-tag 'saved-value nil)))) (provide 'cus-edit-tests) ;;; cus-edit-tests.el ends here From 2ba2e7217f520a43a098b2ef92a452868b88cc70 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 20 Nov 2020 16:45:56 -0500 Subject: [PATCH 76/88] Don't optimize away `eval` when its lexical context is different * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-eval): Obey lexical-binding. --- lisp/emacs-lisp/bytecomp.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cbda16d051b..e6f6a12b53d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2570,7 +2570,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))) From ac98bcc906254da564d77dd33e902e4590ae1d33 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 20 Nov 2020 16:54:06 -0500 Subject: [PATCH 77/88] * test/manual/indent/tcl.tcl: Add string interpolation case --- test/manual/indent/tcl.tcl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl index c3781533ca4..f055be19663 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"; From abd15e088e99b1c6334a427879fead0d557b7447 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 20 Nov 2020 19:28:03 -0300 Subject: [PATCH 78/88] Use cl-letf instead of unwind-protect in a test * test/lisp/cus-edit-tests.el (cus-edit-tests-customize-saved/show-obsolete): Good use case for cl-letf, so use it. Suggested by Stefan Monnier in: https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg00914.html --- test/lisp/cus-edit-tests.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 114e461b7ac..bb88b8dd9fa 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -23,6 +23,7 @@ (require 'ert) (require 'ert-x) +(eval-when-compile (require 'cl-lib)) (require 'cus-edit) (defmacro with-cus-edit-test (buffer &rest body) @@ -71,12 +72,9 @@ (ert-deftest cus-edit-tests-customize-saved/show-obsolete () (with-cus-edit-test "*Customize Saved*" - (unwind-protect - (progn - (put 'cus-edit-tests--obsolete-option-tag 'saved-value '(t)) - (customize-saved) - (should (search-forward cus-edit-tests--obsolete-option-tag nil t))) - (put 'cus-edit-tests--obsolete-option-tag 'saved-value nil)))) + (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 From 932cb10761b9f249c87d7c19778873691f2a5d46 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 20 Nov 2020 19:28:34 -0500 Subject: [PATCH 79/88] * lisp/emacs-lisp/package.el (package-strip-rcs-id): Don't ignore errors Ignoring errors here just postpones the error and replaces a clear "invalid version syntax" with a confusing "package lacks a version". --- lisp/emacs-lisp/package.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d78a1a2856a..9c37ce429a7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2112,8 +2112,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)) From 2c7687738d0b7da60014a7af05ab199936617d71 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 14 Nov 2020 23:44:26 -0800 Subject: [PATCH 80/88] Migrate usage of GPM_CLICK_EVENT to MOUSE_CLICK_EVENT. * src/termhooks.h (enum event_kind): * src/term.c (term_mouse_click, handle_one_term_event): * src/keyboard.c (discard_mouse_events, make_lispy_event): Migrate usage of GPM_CLICK_EVENT to MOUSE_CLICK_EVENT. --- src/keyboard.c | 12 +----------- src/term.c | 8 ++++---- src/termhooks.h | 4 ---- 3 files changed, 5 insertions(+), 19 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 1579c007ecf..49261fcc3e8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -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/term.c b/src/term.c index a0738594bfc..fee3b555751 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 6ab06ceff94..44ab14225fd 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 From 789ee3e1d55a86b9ce38d1374c0e01d04f97eb7d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 21 Nov 2020 15:28:52 +0100 Subject: [PATCH 81/88] Handle connection-local null-device and path-separator variables * doc/lispref/os.texi (System Environment): Add `path-separator' function and `null-device' variable and function. * etc/NEWS: Mention 'null-device' and 'path-separator'. Fix typos. * lisp/files-x.el (path-separator, null-device): New defuns. (Bug#3736) * lisp/net/tramp-adb.el (tramp-adb-connection-local-default-shell-variables): Rename from `tramp-adb-connection-local-default-profile'. * lisp/net/tramp-integration.el (tramp-connection-local-default-system-variables): New defvar. Add it to connection-local profiles. (tramp-connection-local-default-shell-variables): Rename from `tramp-connection-local-default-profile'. * lisp/progmodes/grep.el (grep-hello-file): New defun. (grep-compute-defaults): Use `null-device' function for remote case. Handle remote `hello-file'. Use `process-file-shell-command'. (grep,grep-expand-keywords, lgrep): Use `null-device' function for remote case. --- doc/lispref/os.texi | 22 ++++- etc/NEWS | 31 +++++--- lisp/files-x.el | 10 +++ lisp/net/tramp-adb.el | 23 +++--- lisp/net/tramp-integration.el | 38 ++++++--- lisp/progmodes/grep.el | 146 +++++++++++++++++++++------------- 6 files changed, 178 insertions(+), 92 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 2c30d8ad892..f897cfa4eab 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/etc/NEWS b/etc/NEWS index efec6743237..0cfca39c80f 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 @@ -288,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 @@ -477,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'. @@ -716,11 +721,11 @@ To revert to the previous behavior, *** 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'. +the commands 'customize', 'customize-group', 'customize-apropos' and +'customize-changed-options'. -To customize obsolete user options, use `customize-option' or -`customize-saved'. +To customize obsolete user options, use 'customize-option' or +'customize-saved'. ** Edebug @@ -886,7 +891,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. @@ -1155,8 +1160,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 @@ -1339,7 +1344,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). @@ -2016,7 +2021,7 @@ image API via 'M-x report-emacs-bug'. -- ** On macOS, 's-' and 's-' 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/lisp/files-x.el b/lisp/files-x.el index 911e7ba9e3d..620a2e23f56 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/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7cdb7ebf536..750b735c1b9 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1316,23 +1316,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 - '((shell-file-name . "/system/bin/sh") - (shell-command-switch . "-c")) - "Default connection-local variables for remote adb connections.") - +;;; 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 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) + (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-integration.el b/lisp/net/tramp-integration.el index 7e4a9bf05e5..566c673af16 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: - -(defconst tramp-connection-local-default-profile - '((shell-file-name . "/bin/sh") - (shell-command-switch . "-c")) - "Default connection-local variables for remote connections.") - ;; `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-shell-variables + '((shell-file-name . "/bin/sh") + (shell-command-switch . "-c")) + "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) + (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/progmodes/grep.el b/lisp/progmodes/grep.el index 96838269749..dafba22f777 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 %s " 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 %s " 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 -type 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." '(("" . (mapconcat #'identity opts " ")) ("" . (or dir ".")) ("" . files) - ("" . null-device) + ("" . (null-device)) ("" . excl) ("" . (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)))))) From 0a8cd0116204354e95fbb4ebde64c58123502aa2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 21 Nov 2020 21:49:46 +0200 Subject: [PATCH 82/88] Handle help-form in y-or-n-p and use this in find-file-noselect (bug#5423) * doc/lispref/help.texi (Help Functions): Mention help-form for read-char-from-minibuffer and y-or-n-p. * doc/lispref/minibuf.texi (Yes-or-No Queries): Mention help-form for y-or-n-p. (Multiple Queries): Mention help-form for read-char-from-minibuffer. * lisp/files.el (find-file-noselect): Let-bind multi-line help text to help-form for y-or-n-p. * lisp/subr.el (read-char-choice): Mention help-form in docstring. (read-char-from-minibuffer): Mention help-form in docstring. (y-or-n-p-map): Remove handling of 'help'. (y-or-n-p): Mention help-form in docstring. When help-form is non-nil: add help-char to 'prompt', and bind help-char to help-form-show in composed-keymap. --- doc/lispref/help.texi | 5 ++-- doc/lispref/minibuf.texi | 10 +++++++ etc/NEWS | 6 ++++ lisp/files.el | 59 ++++++++++++++++++++-------------------- lisp/subr.el | 46 +++++++++++++++++++++++++------ 5 files changed, 86 insertions(+), 40 deletions(-) diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 2fa54e3b66b..90406df9c19 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 b6a3434d15e..f1cfd29ef14 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/etc/NEWS b/etc/NEWS index 0cfca39c80f..9361cff3869 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1773,6 +1773,12 @@ 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 diff --git a/lisp/files.el b/lisp/files.el index 3565b7f5710..49c9e5d18d4 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2310,53 +2310,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" diff --git a/lisp/subr.el b/lisp/subr.el index 6e9f66fe97b..1fb0f9ab7e6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2606,7 +2606,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*")) @@ -2767,8 +2771,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)) @@ -2825,7 +2832,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)) @@ -2880,6 +2887,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. @@ -2902,7 +2915,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)) @@ -2911,6 +2930,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) @@ -2923,10 +2943,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))) From a6490343366f2b2331a91dcb693effb3a9dd78f5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 13 Nov 2020 15:28:29 +0100 Subject: [PATCH 83/88] Don't show key ranges if shadowed by different commands * src/keymap.c (describe_vector): Make sure found consecutive keys are either not shadowed or, if they are, that they are shadowed by the same command. (Bug#9293) * test/src/keymap-tests.el (help--describe-vector/bug-9293-one-shadowed-in-range): New test. --- src/keymap.c | 22 ++++++++++++++++++---- test/src/keymap-tests.el | 27 +++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 4 deletions(-) diff --git a/src/keymap.c b/src/keymap.c index 181dcdad3ad..749f4b6b91c 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; + shadowed_by = shadow_lookup (shadow, kludge, Qt, 0); - tem = shadow_lookup (shadow, kludge, Qt, 0); - - if (!NILP (tem)) + if (!NILP (shadowed_by)) { 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. */ diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 610234c5a13..68a8438cb4a 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -200,6 +200,33 @@ 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))) + (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 (binding currently shadowed) +g .. h foo +"))))) + + +;;;; apropos-internal + (ert-deftest keymap-apropos-internal () (should (equal (apropos-internal "^next-line$") '(next-line))) (should (>= (length (apropos-internal "^help")) 100)) From 84dd5c9bea9112daa339e4c1b8e4e556988f3195 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 13 Nov 2020 15:28:34 +0100 Subject: [PATCH 84/88] Don't shadow bindings by the same command * src/keymap.c (describe_vector): Do not say binding is shadowed if the other key binding points to the same command. (Bug#9293) * test/src/keymap-tests.el (help--describe-vector/bug-9293-same-command-does-not-shadow): New test. --- src/keymap.c | 2 +- test/src/keymap-tests.el | 24 ++++++++++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/src/keymap.c b/src/keymap.c index 749f4b6b91c..aaba2ac838a 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -3130,7 +3130,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, { shadowed_by = shadow_lookup (shadow, kludge, Qt, 0); - if (!NILP (shadowed_by)) + if (!NILP (shadowed_by) && !EQ (shadowed_by, definition)) { if (mention_shadow) this_shadowed = 1; diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 68a8438cb4a..e467b1f0551 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -224,6 +224,30 @@ f foo (binding currently shadowed) 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 From fb9326b45c769f83b619278eae41f680577d1b05 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 13 Nov 2020 19:15:21 +0100 Subject: [PATCH 85/88] Say which command shadows a key binding * src/keymap.c (describe_vector): Say which command shadows this binding. (Bug#9293) * test/src/keymap-tests.el (help--describe-vector/bug-9293-one-shadowed-in-range): Adapt test. --- src/keymap.c | 8 +++++++- test/src/keymap-tests.el | 6 +++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/keymap.c b/src/keymap.c index aaba2ac838a..e22eb411f63 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -3223,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/test/src/keymap-tests.el b/test/src/keymap-tests.el index e467b1f0551..6411cd1f0d4 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -58,7 +58,6 @@ (let* (menu-item-filter-ran (object `(menu-item "2" identity :filter ,(lambda (cmd) - (message "foo") (setq menu-item-filter-ran t) cmd)))) (keymap--get-keyelt object t) @@ -213,14 +212,15 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." map)) (shadow-map (let ((map (make-keymap))) (define-key map "f" 'bar) - map))) + 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 (binding currently shadowed) +f foo (currently shadowed by `bar') g .. h foo "))))) From b6339fc19c378d66ce1bc53499552dfaa3c0c8c0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 22 Nov 2020 03:24:26 +0100 Subject: [PATCH 86/88] Test interactive-only spec of with-suppressed-warnings * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Test suppressing warning with interactive-only. --- test/lisp/emacs-lisp/bytecomp-tests.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 13cbedfe1f7..e0a3cc2fb82 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -808,6 +808,12 @@ literals (Bug#20852)." '((obsolete obsolete-variable)) "obsolete") + (test-suppression + '(defun zot () + (next-line)) + '((interactive-only next-line)) + "interactive use only") + (test-suppression '(defun zot () (mapcar #'list '(1 2 3)) From 9490f12c4dc4deb16f4e900646319f6de033982c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 22 Nov 2020 07:19:11 +0100 Subject: [PATCH 87/88] Test for byte-compiler warning "variable lacks prefix" * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test): New macro. (bytecomp-warn-wrong-args, bytecomp-warn-wrong-args-subr): Use above new macro. (bytecomp-warn-variable-lacks-prefix): New test. --- test/lisp/emacs-lisp/bytecomp-tests.el | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e0a3cc2fb82..680aa514a27 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 From 9b6ad3107f93d40f82c3c53dc0984c6d70aded83 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 22 Nov 2020 19:56:23 +0100 Subject: [PATCH 88/88] Replace /dev/null by remote null-device in Tramp. * lisp/net/tramp-adb.el (tramp-adb-get-ls-command) (tramp-adb-handle-set-file-times, tramp-adb-handle-process-file): Use `tramp-get-remote-null-device'. * lisp/net/tramp-compat.el (tramp-tramp-file-p): Declare. (tramp-compat-null-device): New defalias. * lisp/net/tramp-sh.el (tramp-methods) : (tramp-perl-encode-with-module, tramp-perl-decode-with-module) (tramp-perl-encode, tramp-perl-decode, tramp-awk-decode): Use "%n" marker. (tramp-do-directory-files-and-attributes-with-stat) (tramp-sh-handle-file-name-all-completions) (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-insert-directory, tramp-sh-handle-process-file) (tramp-set-remote-path, tramp-open-connection-setup-interactive-shell) (tramp-find-inline-encoding, tramp-send-command-and-check) (tramp-get-remote-path, tramp-get-ls-command, tramp-get-ls-command-with) (tramp-get-remote-awk, tramp-get-remote-hexdump, tramp-get-remote-od) (tramp-get-env-with-u-option): Use `tramp-get-remote-null-device'. (tramp-remote-coding-commands, tramp-call-local-coding-command): Adapt docstring. * lisp/net/tramp-smb.el (tramp-smb-conf): Use `null-device'. (tramp-smb-handle-file-acl): Use `tramp-get-remote-null-device'. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-get-remote-null-device): New defun. (tramp-interrupt-process): Use it. --- lisp/net/tramp-adb.el | 18 ++++--- lisp/net/tramp-compat.el | 8 +++ lisp/net/tramp-sh.el | 106 ++++++++++++++++++++++++++------------- lisp/net/tramp-smb.el | 4 +- lisp/net/tramp.el | 14 +++++- 5 files changed, 104 insertions(+), 46 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 750b735c1b9..51cb316249d 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)))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9a4e16efe20..7fae9ba7e2f 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-sh.el b/lisp/net/tramp-sh.el index f9b218a970a..d2265ed1dfa 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 = ) { ((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))) @@ -3146,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. @@ -3188,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)))) @@ -4117,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) @@ -4439,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 @@ -4454,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))) @@ -4570,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.") @@ -4657,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) @@ -4665,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 " (tramp-get-remote-null-device vec)) ?o (tramp-get-remote-od vec))) value (replace-regexp-in-string "%" "%%" value))) (when (string-match-p "\\(^\\|[^%]\\)%t" value) @@ -4727,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)." @@ -5199,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) @@ -5416,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 @@ -5520,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)))))) @@ -5541,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) @@ -5820,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 | 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 8a48ffc09b8..cafa97cec09 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 a98d478bc1a..d40f9a5927c 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."