diff options
| author | Andrea Corallo <akrl@sdf.org> | 2021-04-13 12:06:23 +0200 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2021-04-13 12:06:23 +0200 |
| commit | b064ddd3f600ed28e62b09d556ecced5f80d9883 (patch) | |
| tree | 2ddf4889f385beb34cd064f245a7e59265377c37 | |
| parent | 2d23f19e7d5ff8a1ec1a188dcd530c185029d1f8 (diff) | |
| parent | 6de79542e43ece9a12ebc032c275a6c3fee0b73b (diff) | |
| download | emacs-b064ddd3f600ed28e62b09d556ecced5f80d9883.tar.gz | |
Merge remote-tracking branch 'savannah/master' into native-comp
162 files changed, 3645 insertions, 2589 deletions
diff --git a/.gitignore b/.gitignore index 53611ce9190..fcbc9cd7f46 100644 --- a/.gitignore +++ b/.gitignore @@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el lisp/cedet/semantic/wisent/js-wy.el lisp/cedet/semantic/wisent/python-wy.el lisp/cedet/srecode/srt-wy.el +lisp/cedet/semantic/grammar-wy.el lisp/eshell/esh-groups.el lisp/finder-inf.el lisp/leim/ja-dic/ @@ -189,6 +190,7 @@ lib-src/make-docfile lib-src/make-fingerprint lib-src/movemail lib-src/profile +lib-src/seccomp-filter lib-src/test-distrib lib-src/update-game-score nextstep/Cocoa/Emacs.base/Contents/Info.plist @@ -302,3 +304,9 @@ nt/emacs.rc nt/emacsclient.rc src/gdb.ini /var/ + +# Seccomp filter files. +lib-src/seccomp-filter.bpf +lib-src/seccomp-filter.pfc +lib-src/seccomp-filter-exec.bpf +lib-src/seccomp-filter-exec.pfc diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 35ce55461f3..4172411e034 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -51,14 +51,11 @@ BOVINE = \ ${bovinedir}/make-by.el \ ${bovinedir}/scm-by.el -## FIXME Should include this one too: -## ${cedetdir}/semantic/grammar-wy.el -## but semantic/grammar.el (which is what we use to generate grammar-wy.el) -## requires it! https://debbugs.gnu.org/16008 -WISENT = \ - ${wisentdir}/javat-wy.el \ - ${wisentdir}/js-wy.el \ - ${wisentdir}/python-wy.el \ +WISENT = \ + ${cedetdir}/semantic/grammar-wy.el \ + ${wisentdir}/javat-wy.el \ + ${wisentdir}/js-wy.el \ + ${wisentdir}/python-wy.el \ ${cedetdir}/srecode/srt-wy.el ALL = ${BOVINE} ${WISENT} diff --git a/admin/update_autogen b/admin/update_autogen index 35c391da19e..11c4313ae37 100755 --- a/admin/update_autogen +++ b/admin/update_autogen @@ -317,7 +317,7 @@ EOF echo "Finding loaddef targets..." find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \ - sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ + sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ >| $tempfile || die "Error finding targets" genfiles= @@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error" ## Ignore comment differences. -[ ! "$lboot_flag" ] || \ +[ ! "$lboot_flag" ] || \ diff -q -I '^;' $ldefs_in $ldefs_out || \ cp $ldefs_in $ldefs_out || die "cp ldefs_boot error" +# Refresh the prebuilt grammar-wy.el +grammar_in=lisp/cedet/semantic/grammar-wy.el +grammar_out=lisp/cedet/semantic/grm-wy-boot.el +make -C admin/grammars/ ../../$grammar_in +cp $grammar_in $grammar_out || die "cp grm_wy_boot error" + echo "Checking status of loaddef files..." ## It probably would be fine to just check+commit lisp/, since ## making autoloads should not effect any other files. But better ## safe than sorry. -modified=$(status $genfiles $ldefs_out) || die +modified=$(status $genfiles $ldefs_out $grammar_out) || die commit "loaddefs" $modified || die "commit error" diff --git a/configure.ac b/configure.ac index 3892eaed64b..a47871fbd89 100644 --- a/configure.ac +++ b/configure.ac @@ -4302,6 +4302,22 @@ fi AC_SUBST([BLESSMAIL_TARGET]) AC_SUBST([LIBS_MAIL]) +HAVE_SECCOMP=no +AC_CHECK_HEADERS( + [linux/seccomp.h linux/filter.h], + [AC_CHECK_DECLS( + [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC], + [HAVE_SECCOMP=yes], [], + [[ + #include <linux/seccomp.h> + ]])]) +AC_SUBST([HAVE_SECCOMP]) + +EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0]) +AC_SUBST([HAVE_LIBSECCOMP]) +AC_SUBST([LIBSECCOMP_LIBS]) +AC_SUBST([LIBSECCOMP_CFLAGS]) + OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ @@ -4309,7 +4325,7 @@ getrusage get_current_dir_name \ lrand48 random rint trunc \ select getpagesize setlocale newlocale \ getrlimit setrlimit shutdown \ -pthread_sigmask strsignal setitimer timer_getoverrun \ +pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ getpwent endpwent getgrent endgrent \ @@ -5607,6 +5623,12 @@ gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS +# timer_getoverrun needs the same libarary as timer_settime +OLD_LIBS=$LIBS +LIBS="$LIB_TIMER_TIME $LIBS" +AC_CHECK_FUNCS(timer_getoverrun) +LIBS=$OLD_LIBS + if test "${opsys}" = "mingw32"; then CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc" # Remove unneeded switches from the value of CC that goes to Makefiles @@ -5796,9 +5818,10 @@ optsep= emacs_config_features= for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ - M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND \ - THREADS TIFF TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS \ - X_TOOLKIT ZLIB; do + M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \ + SOUND THREADS TIFF \ + TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ + ZLIB; do case $opt in PDUMPER) val=${with_pdumper} ;; diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 3a166e404a8..bec7f37547c 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}): the variable @code{fido-mode} to @code{t} (@pxref{Easy Customization}). +@findex icomplete-vertical-mode +@cindex Icomplete vertical mode + + Icomplete mode and Fido mode display the possible completions on the +same line as the prompt by default. To display the completion candidates +vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or +customize the variable @code{icomplete-vertical-mode} to @code{t} +(@pxref{Easy Customization}). + @node Buffer Menus @subsection Customizing Buffer Menus diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index f3c42bcea7f..38430a2ab15 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -201,6 +201,14 @@ something before the starting point, type @kbd{C-r} to switch to a backward search, leaving the search string unchanged. Similarly, @kbd{C-s} in a backward search switches to a forward search. +@cindex search, changing direction +@vindex isearch-repeat-on-direction-change + When you change the direction of a search, the first command you +type will, by default, remain on the same match, and the cursor will +move to the other end of the match. To move to another match +immediately, customize the variable +@code{isearch-repeat-on-direction-change} to @code{t}. + @cindex search, wrapping around @cindex search, overwrapped @cindex wrapped search diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 8942f55affb..323130f2378 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1510,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and must be in the form itself rather than at a higher level. Backtracking is also disabled after successfully matching a quoted -symbol or string specification, since this usually indicates a -recognized construct. But if you have a set of alternative constructs that -all begin with the same symbol, you can usually work around this -constraint by factoring the symbol out of the alternatives, e.g., -@code{["foo" &or [first case] [second case] ...]}. +symbol, string specification, or @code{&define} keyword, since this +usually indicates a recognized construct. But if you have a set of +alternative constructs that all begin with the same symbol, you can +usually work around this constraint by factoring the symbol out of the +alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}. Most needs are satisfied by these two ways that backtracking is automatically disabled, but occasionally it is useful to explicitly diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index dade8555187..be0c835b035 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -531,6 +531,7 @@ Scoping Rules for Variable Bindings * Dynamic Binding Tips:: Avoiding problems with dynamic binding. * Lexical Binding:: A different type of local variable binding. * Using Lexical Binding:: How to enable lexical binding. +* Converting to Lexical Binding:: Convert existing code to lexical binding. Buffer-Local Variables diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index cd2ff8f3b31..a9d20c543da 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2628,7 +2628,7 @@ When Emacs gets one of these commands, it generates a @code{delete-frame} event, whose normal definition is a command that calls the function @code{delete-frame}. @xref{Misc Events}. -@deffn Command delete-other-frames &optional frame +@deffn Command delete-other-frames &optional frame iconify This command deletes all frames on @var{frame}'s terminal, except @var{frame}. If @var{frame} uses another frame's minibuffer, that minibuffer frame is left untouched. The argument @var{frame} must @@ -2639,6 +2639,9 @@ this command works by calling @code{delete-frame} with @var{force} This function does not delete any of @var{frame}'s child frames (@pxref{Child Frames}). If @var{frame} is a child frame, it deletes @var{frame}'s siblings only. + +With the prefix argument @var{iconify}, the frames are iconified rather +than deleted. @end deffn diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 6cf4dd21c19..88f2f14c092 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1660,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}. The macro @code{define-minor-mode} offers a convenient way of implementing a mode in one self-contained definition. -@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{} +@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{} This macro defines a new minor mode whose name is @var{mode} (a symbol). It defines a command named @var{mode} to toggle the minor mode, with @var{doc} as its documentation string. @@ -1675,41 +1675,12 @@ If @var{doc} is @code{nil}, the macro supplies a default documentation string explaining the above. By default, it also defines a variable named @var{mode}, which is set to -@code{t} or @code{nil} by enabling or disabling the mode. The variable -is initialized to @var{init-value}. Except in unusual circumstances -(see below), this value must be @code{nil}. +@code{t} or @code{nil} by enabling or disabling the mode. -The string @var{lighter} says what to display in the mode line -when the mode is enabled; if it is @code{nil}, the mode is not displayed -in the mode line. - -The optional argument @var{keymap} specifies the keymap for the minor -mode. If non-@code{nil}, it should be a variable name (whose value is -a keymap), a keymap, or an alist of the form - -@example -(@var{key-sequence} . @var{definition}) -@end example - -@noindent -where each @var{key-sequence} and @var{definition} are arguments -suitable for passing to @code{define-key} (@pxref{Changing Key -Bindings}). If @var{keymap} is a keymap or an alist, this also -defines the variable @code{@var{mode}-map}. - -The above three arguments @var{init-value}, @var{lighter}, and -@var{keymap} can be (partially) omitted when @var{keyword-args} are -used. The @var{keyword-args} consist of keywords followed by +The @var{keyword-args} consist of keywords followed by corresponding values. A few keywords have special meanings: @table @code -@item :group @var{group} -Custom group name to use in all generated @code{defcustom} forms. -Defaults to @var{mode} without the possible trailing @samp{-mode}. -@strong{Warning:} don't use this default group name unless you have -written a @code{defgroup} to define that group properly. @xref{Group -Definitions}. - @item :global @var{global} If non-@code{nil}, this specifies that the minor mode should be global rather than buffer-local. It defaults to @code{nil}. @@ -1719,19 +1690,34 @@ One of the effects of making a minor mode global is that the through the Customize interface turns the mode on and off, and its value can be saved for future Emacs sessions (@pxref{Saving Customizations,,, emacs, The GNU Emacs Manual}. For the saved -variable to work, you should ensure that the @code{define-minor-mode} -form is evaluated each time Emacs starts; for packages that are not -part of Emacs, the easiest way to do this is to specify a -@code{:require} keyword. +variable to work, you should ensure that the minor mode function +is available each time Emacs starts; usually this is done by +marking the @code{define-minor-mode} form as autoloaded. @item :init-value @var{init-value} -This is equivalent to specifying @var{init-value} positionally. +This is the value to which the @var{mode} variable is initialized. +Except in unusual circumstances (see below), this value must be +@code{nil}. @item :lighter @var{lighter} -This is equivalent to specifying @var{lighter} positionally. +The string @var{lighter} says what to display in the mode line +when the mode is enabled; if it is @code{nil}, the mode is not displayed +in the mode line. @item :keymap @var{keymap} -This is equivalent to specifying @var{keymap} positionally. +The optional argument @var{keymap} specifies the keymap for the minor +mode. If non-@code{nil}, it should be a variable name (whose value is +a keymap), a keymap, or an alist of the form + +@example +(@var{key-sequence} . @var{definition}) +@end example + +@noindent +where each @var{key-sequence} and @var{definition} are arguments +suitable for passing to @code{define-key} (@pxref{Changing Key +Bindings}). If @var{keymap} is a keymap or an alist, this also +defines the variable @code{@var{mode}-map}. @item :variable @var{place} This replaces the default variable @var{mode}, used to store the state diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 6e82a97030e..cc546a92d63 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -124,17 +124,25 @@ which part of the document contains the ``readable'' text, and will only display this part. This usually gets rid of menus and the like. @findex eww-toggle-fonts -@findex shr-use-fonts +@vindex shr-use-fonts @kindex F The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable. @findex eww-toggle-colors -@findex shr-use-colors -@kindex F +@vindex shr-use-colors +@kindex M-C The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use HTML-specified colors or not. This sets the @code{shr-use-colors} variable. +@findex eww-toggle-images +@vindex shr-inhibit-images +@kindex M-I +@cindex Image Display + The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i) +toggles whether to display images or not. This also sets the +@code{shr-inhibit-images} variable. + @findex eww-download @vindex eww-download-directory @kindex d @@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling (ImageMagick support required) then larger images are scaled down. You can block specific images completely by customizing @code{shr-blocked-images}. +@vindex shr-inhibit-images + You can control image display by customizing +@code{shr-inhibit-images}. If this variable is @code{nil}, display +the ``ALT'' text of images instead. + @vindex shr-color-visible-distance-min @vindex shr-color-visible-luminance-min @cindex Contrast diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5ea0275bafe..40245acb8e5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5067,6 +5067,33 @@ remote files}. @item +How to prevent @value{tramp} from clearing the @code{recentf-list}? + +When @value{tramp} cleans a connection, it removes the respective +remote file name(s) from @code{recentf-list}. This is needed, because +an unresponsive remote host could trigger @code{recentf} to connect +that host again and again. + +If you find the cleanup disturbing, because the file names in +@code{recentf-list} are precious to you, you could add the following +two forms in your @file{~/.emacs} after loading the @code{tramp} and +@code{recentf} packages: + +@lisp +@group +(remove-hook + 'tramp-cleanup-connection-hook + #'tramp-recentf-cleanup) +@end group +@group +(remove-hook + 'tramp-cleanup-all-connections-hook + #'tramp-recentf-cleanup-all) +@end group +@end lisp + + +@item I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d} @value{tramp} comes with compatibility code for different Emacs @@ -95,6 +95,17 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". +** Emacs now supports loading a Secure Computing filter. +This is supported only on capable GNU/Linux systems. To activate, +invoke Emacs with the '--seccomp=FILE' command-line option. FILE must +name a binary file containing an array of 'struct sock_filter' +structures. Emacs will then install that list of Secure Computing +filters into its own process early during the startup process. You +can use this functionality to put an Emacs process in a sandbox to +avoid security issues when executing untrusted code. See the manual +page for 'seccomp' system call, for details about Secure Computing +filters. + * Changes in Emacs 28.1 @@ -270,6 +281,9 @@ input using the minibuffer. * Editing Changes in Emacs 28.1 +++ +** A prefix arg now causes 'delete-other-frames' to only iconify frames + ++++ ** New command 'execute-extended-command-for-buffer'. This new command, bound to 'M-S-x', works like 'execute-extended-command', but limits the set of commands to the @@ -372,6 +386,12 @@ trying to be non-destructive. This command opens a new buffer called "*Memory Report*" and gives a summary of where Emacs is using memory currently. ++++ +** New user option 'isearch-repeat-on-direction-change'. +When this option is set, direction changes in Isearch move to another +search match, if there is one, instead of moving point to the other +end of the current match. + ** Outline +++ @@ -482,6 +502,13 @@ documented. SMIE is now always enabled and 'ruby-use-smie' only controls whether indentation is done using SMIE or with the old ad-hoc code. +** Icomplete + ++++ +*** New minor mode Icomplete-Vertical mode. +This mode is intended to be used with Icomplete or Fido, to display the +list of completions candidates vertically instead of horizontally. + --- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has @@ -934,6 +961,14 @@ take the actual screenshot, and defaults to "ImageMagick import". A server entry retrieved by auth-source can request a desired smtp authentication mechanism by setting a value for the key 'smtp-auth'. +** Search and Replace + +*** New user option 'isearch-wrap-pause' defines how to wrap the search. +There are choices to disable wrapping completely and to wrap immediately. +When wrapping immediately, it consistently handles the numeric arguments +of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'), +continuing with the remaining count after wrapping. + ** Grep +++ @@ -2264,6 +2299,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'M-g n n p p' to navigate next-error matches. Any other key exits transient mode and then is executed normally. 'repeat-exit-key' defines an additional key to exit mode like 'isearch-exit' ('RET'). +With 'repeat-keep-prefix' you can keep the prefix arg of the previous command. +For example, this can help to reverse the window navigation direction +with e.g. 'C-x o M-- o o'. Also it can help to set a new step with +e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns. * New Modes and Packages in Emacs 28.1 @@ -2340,6 +2379,11 @@ This is to keep the same behavior as Eshell. * Incompatible Lisp Changes in Emacs 28.1 ++++ +** The use of positional arguments in 'define-minor-mode' is obsolete. +These were actually rendered obsolete in Emacs-21 but were never +marked as such. + ** 'facemenu-color-alist' is now obsolete, and is not used. ** 'facemenu.el' is no longer preloaded. @@ -2404,11 +2448,6 @@ parameter. by mistake and were not useful to Lisp code. --- -** Loading 'generic-x' unconditionally loads all modes. -The user option 'generic-extras-enable-list' is now obsolete, and -setting it has no effect. - ---- ** The 'load-dangerous-libraries' variable is now obsolete. It was used to allow loading Lisp libraries compiled by XEmacs, a modified version of Emacs which is no longer actively maintained. @@ -2524,6 +2563,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', ** The 'values' variable is now obsolete. ++++ +** The '&define' keyword in an Edebug specification now disables backtracking. +The implementation was buggy, and multiple &define forms in an &or +form should be exceedingly rare. See the Info node 'Backtracking' in +the Emacs Lisp reference manual for background. + * Lisp Changes in Emacs 28.1 diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 05eb524d19b..923d0cf5e72 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -189,6 +189,30 @@ LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) +HAVE_SECCOMP=@HAVE_SECCOMP@ +HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@ +LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@ +LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@ + +# Currently, we can only generate seccomp filter files for x86-64. +ifeq ($(HAVE_SECCOMP),yes) +ifeq ($(HAVE_LIBSECCOMP),yes) +ifeq ($(shell uname -m),x86_64) +# We require SECCOMP_RET_KILL_PROCESS, which is only available in +# Linux 4.14 and later. +ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \ + sort -C -t . -n -k 1,1 -k 2,2 && \ + echo 1),1) +SECCOMP_FILTER=1 +endif +endif +endif +endif + +ifeq ($(SECCOMP_FILTER),1) +DONT_INSTALL += seccomp-filter$(EXEEXT) +endif + ## Extra libraries to use when linking movemail. LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS) @@ -218,6 +242,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} +ifeq ($(SECCOMP_FILTER),1) +all: seccomp-filter.bpf seccomp-filter-exec.bpf +endif + .PHONY: all need-blessmail maybe-blessmail LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM) @@ -400,4 +428,15 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< +ifeq ($(SECCOMP_FILTER),1) +seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) + $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \ + $(LIBSECCOMP_LIBS) -o $@ + +seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT) + $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ + seccomp-filter.bpf seccomp-filter.pfc \ + seccomp-filter-exec.bpf seccomp-filter-exec.pfc +endif + ## Makefile ends here. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c new file mode 100644 index 00000000000..fc3c3a0c074 --- /dev/null +++ b/lib-src/seccomp-filter.c @@ -0,0 +1,363 @@ +/* Generate a Secure Computing filter definition file. + +Copyright (C) 2020-2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see +<https://www.gnu.org/licenses/>. */ + +/* This program creates a small Secure Computing filter usable for a +typical minimal Emacs sandbox. See the man page for `seccomp' for +details about Secure Computing filters. This program requires the +`libseccomp' library. However, the resulting filter file requires +only a Linux kernel supporting the Secure Computing extension. + +Usage: + + seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc + +This writes the raw `struct sock_filter' array to out.bpf and a +human-readable representation to out.pfc. Additionally, it writes +variants of those files that can be used to sandbox Emacs before +'execve' to out-exec.bpf and out-exec.pfc. */ + +#include "config.h" + +#include <errno.h> +#include <limits.h> +#include <stdarg.h> +#include <stdbool.h> +#include <stdlib.h> +#include <stdint.h> +#include <stdio.h> +#include <time.h> + +#include <asm/prctl.h> +#include <sys/ioctl.h> +#include <sys/mman.h> +#include <sys/prctl.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <linux/futex.h> +#include <linux/filter.h> +#include <linux/seccomp.h> +#include <fcntl.h> +#include <sched.h> +#include <seccomp.h> +#include <unistd.h> + +#include "verify.h" + +static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void +fail (int error, const char *format, ...) +{ + va_list ap; + va_start (ap, format); + if (error == 0) + { + vfprintf (stderr, format, ap); + fputc ('\n', stderr); + } + else + { + char buffer[1000]; + vsnprintf (buffer, sizeof buffer, format, ap); + errno = error; + perror (buffer); + } + va_end (ap); + fflush (NULL); + exit (EXIT_FAILURE); +} + +/* This binary is trivial, so we use a single global filter context + object that we release using `atexit'. */ + +static scmp_filter_ctx ctx; + +static void +release_context (void) +{ + seccomp_release (ctx); +} + +/* Wrapper functions and macros for libseccomp functions. We exit + immediately upon any error to avoid error checking noise. */ + +static void +set_attribute (enum scmp_filter_attr attr, uint32_t value) +{ + int status = seccomp_attr_set (ctx, attr, value); + if (status < 0) + fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value); +} + +/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you + don't have to specify the number of comparator arguments, and any + failure will exit the process. */ + +#define RULE(action, syscall, ...) \ + do \ + { \ + const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \ + enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \ + int status = seccomp_rule_add_array (ctx, (action), (syscall), \ + arg_cnt, arg_array); \ + if (status < 0) \ + fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \ + #action, #syscall, arg_cnt, #__VA_ARGS__); \ + } \ + while (false) + +static void +export_filter (const char *file, + int (*function) (const scmp_filter_ctx, int), + const char *name) +{ + int fd = TEMP_FAILURE_RETRY ( + open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC, + 0644)); + if (fd < 0) + fail (errno, "open %s", file); + int status = function (ctx, fd); + if (status < 0) + fail (-status, "%s", name); + if (close (fd) != 0) + fail (errno, "close"); +} + +#define EXPORT_FILTER(file, function) \ + export_filter ((file), (function), #function) + +int +main (int argc, char **argv) +{ + if (argc != 5) + fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc", + argv[0]); + + /* Any unhandled syscall should abort the Emacs process. */ + ctx = seccomp_init (SCMP_ACT_KILL_PROCESS); + if (ctx == NULL) + fail (0, "seccomp_init"); + atexit (release_context); + + /* We want to abort immediately if the architecture is unknown. */ + set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS); + set_attribute (SCMP_FLTATR_CTL_NNP, 1); + set_attribute (SCMP_FLTATR_CTL_TSYNC, 1); + + verify (CHAR_BIT == 8); + verify (sizeof (int) == 4 && INT_MIN == INT32_MIN + && INT_MAX == INT32_MAX); + verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN + && LONG_MAX == INT64_MAX); + verify (sizeof (void *) == 8); + verify ((uintptr_t) NULL == 0); + + /* Allow a clean exit. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group)); + + /* Allow `mmap' and friends. This is necessary for dynamic loading, + reading the portable dump file, and thread creation. We don't + allow pages to be both writable and executable. */ + verify (MAP_PRIVATE != 0); + verify (MAP_SHARED != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. Also + allow allocating thread stacks. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS + | MAP_FIXED | MAP_DENYWRITE | MAP_STACK + | MAP_NORESERVE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_EXEC)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED + | MAP_DENYWRITE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect), + /* Don't allow making pages executable. */ + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE), 0)); + + /* Futexes are used everywhere. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex), + SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE)); + + /* Allow basic dynamic memory management. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk)); + + /* Allow some status inquiries. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp)); + + /* Allow operations on open file descriptors. File descriptors are + capabilities, and operating on them shouldn't cause security + issues. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (read)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (write)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (close)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat)); + + /* Allow read operations on the filesystem. If necessary, these + should be further restricted using mount namespaces. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (access)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd)); + + /* Allow opening files, assuming they are only opened for + reading. */ + verify (O_WRONLY != 0); + verify (O_RDWR != 0); + verify (O_CREAT != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (open), + SCMP_A1_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY | O_NOFOLLOW), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY | O_NOFOLLOW), + 0)); + + /* Allow `tcgetpgrp'. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl), + SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO), + SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP)); + + /* Allow reading (but not setting) file flags. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + + /* Allow reading random numbers from the kernel. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom)); + + /* Changing the umask is uncritical. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask)); + + /* Allow creation of pipes. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2)); + + /* Allow reading (but not changing) resource limits. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); + + /* Block changing resource limits, but don't crash. */ + RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */); + + /* Emacs installs signal handlers, which is harmless. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); + + /* Allow reading the current time. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime), + SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (time)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday)); + + /* Allow timer support. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); + + /* Allow thread creation. See the NOTES section in the manual page + for the `clone' function. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone), + SCMP_A0_64 (SCMP_CMP_MASKED_EQ, + /* Flags needed to create threads. See + create_thread in libc. */ + ~(CLONE_VM | CLONE_FS | CLONE_FILES + | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD + | CLONE_SETTLS | CLONE_PARENT_SETTID + | CLONE_CHILD_CLEARTID), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list)); + + /* Allow setting the process name for new threads. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME)); + + /* Allow some event handling functions used by glib. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll)); + + /* Don't allow creating sockets (network access would be extremely + dangerous), but also don't crash. */ + RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket)); + + EXPORT_FILTER (argv[1], seccomp_export_bpf); + EXPORT_FILTER (argv[2], seccomp_export_pfc); + + /* When applying a Seccomp filter before executing the Emacs binary + (e.g. using the `bwrap' program), we need to allow further system + calls. Firstly, the wrapper binary will need to `execve' the + Emacs binary. Furthermore, the C library requires some system + calls at startup time to set up thread-local storage. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), + SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs)); + + /* We want to allow starting the Emacs binary itself with the + --seccomp flag, so we need to allow the `prctl' and `seccomp' + system calls. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS), + SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0), + SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp), + SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER), + SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC)); + + EXPORT_FILTER (argv[3], seccomp_export_bpf); + EXPORT_FILTER (argv[4], seccomp_export_pfc); +} diff --git a/lisp/array.el b/lisp/array.el index cd8971bd266..6632da55dd4 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -1,4 +1,4 @@ -;;; array.el --- array editing commands for GNU Emacs +;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc. @@ -769,25 +769,25 @@ Return COLUMN." (defvar array-mode-map (let ((map (make-keymap))) - (define-key map "\M-ad" 'array-display-local-variables) - (define-key map "\M-am" 'array-make-template) - (define-key map "\M-ae" 'array-expand-rows) - (define-key map "\M-ar" 'array-reconfigure-rows) - (define-key map "\M-a=" 'array-what-position) - (define-key map "\M-ag" 'array-goto-cell) - (define-key map "\M-af" 'array-fill-rectangle) - (define-key map "\C-n" 'array-next-row) - (define-key map "\C-p" 'array-previous-row) - (define-key map "\C-f" 'array-forward-column) - (define-key map "\C-b" 'array-backward-column) - (define-key map "\M-n" 'array-copy-down) - (define-key map "\M-p" 'array-copy-up) - (define-key map "\M-f" 'array-copy-forward) - (define-key map "\M-b" 'array-copy-backward) - (define-key map "\M-\C-n" 'array-copy-row-down) - (define-key map "\M-\C-p" 'array-copy-row-up) - (define-key map "\M-\C-f" 'array-copy-column-forward) - (define-key map "\M-\C-b" 'array-copy-column-backward) + (define-key map "\M-ad" #'array-display-local-variables) + (define-key map "\M-am" #'array-make-template) + (define-key map "\M-ae" #'array-expand-rows) + (define-key map "\M-ar" #'array-reconfigure-rows) + (define-key map "\M-a=" #'array-what-position) + (define-key map "\M-ag" #'array-goto-cell) + (define-key map "\M-af" #'array-fill-rectangle) + (define-key map "\C-n" #'array-next-row) + (define-key map "\C-p" #'array-previous-row) + (define-key map "\C-f" #'array-forward-column) + (define-key map "\C-b" #'array-backward-column) + (define-key map "\M-n" #'array-copy-down) + (define-key map "\M-p" #'array-copy-up) + (define-key map "\M-f" #'array-copy-forward) + (define-key map "\M-b" #'array-copy-backward) + (define-key map "\M-\C-n" #'array-copy-row-down) + (define-key map "\M-\C-p" #'array-copy-row-up) + (define-key map "\M-\C-f" #'array-copy-column-forward) + (define-key map "\M-\C-b" #'array-copy-column-backward) map) "Keymap used in array mode.") @@ -815,17 +815,17 @@ in array mode may have different values assigned to the variables. The variables are: Variables you assign: - array-max-row: The number of rows in the array. - array-max-column: The number of columns in the array. - array-columns-per-line: The number of columns in the array + `array-max-row': The number of rows in the array. + `array-max-column': The number of columns in the array. + `array-columns-per-line': The number of columns in the array per line of buffer. - array-field-width: The width of each field, in characters. - array-rows-numbered: A logical variable describing whether to ignore + `array-field-width': The width of each field, in characters. + `array-rows-numbered': A logical variable describing whether to ignore row numbers in the buffer. Variables which are calculated: - array-line-length: The number of characters in a buffer line. - array-lines-per-row: The number of buffer lines used to + `array-line-length': The number of characters in a buffer line. + `array-lines-per-row': The number of buffer lines used to display each row. The following commands are available (an asterisk indicates it may diff --git a/lisp/autoarg.el b/lisp/autoarg.el index c2cb0c7051c..7c2c6f1030d 100644 --- a/lisp/autoarg.el +++ b/lisp/autoarg.el @@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate]. `C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times. \\{autoarg-mode-map}" - nil " Aarg" autoarg-mode-map :global t :group 'keyboard) + :lighter" Aarg" :global t :group 'keyboard) ;;;###autoload (define-minor-mode autoarg-kp-mode @@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys `kp-1' etc. to supply digit arguments. \\{autoarg-kp-mode-map}" - nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard + :lighter " Aakp" :global t :group 'keyboard (if autoarg-kp-mode (dotimes (i 10) (let ((sym (intern (format "kp-%d" i)))) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 57258f9c833..1bb40c90ff5 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to revert them manually. Use this option with care since it could lead to excessive auto-reverts. -For more information, see Info node `(emacs)Autorevert'." +For more information, see Info node `(emacs)Auto Revert'." :group 'auto-revert :type 'boolean - :link '(info-link "(emacs)Autorevert")) + :link '(info-link "(emacs)Auto Revert")) (defcustom global-auto-revert-ignore-modes () "List of major modes Global Auto-Revert Mode should not check." diff --git a/lisp/calculator.el b/lisp/calculator.el index 6dd8d9a7ec1..99c9b6290c4 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -836,10 +836,11 @@ The result should not exceed the screen width." "Convert the given STR to a number, according to the value of `calculator-input-radix'." (if calculator-input-radix - (string-to-number str (cadr (assq calculator-input-radix - '((bin 2) (oct 8) (hex 16))))) - ;; Allow entry of "1.e3". - (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str))) + (string-to-number str (cadr (assq calculator-input-radix + '((bin 2) (oct 8) (hex 16))))) + ;; parse numbers similarly to calculators + ;; (see tests in test/lisp/calculator-tests.el) + (let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str))) (float (string-to-number str))))) (defun calculator-push-curnum () diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 04b525efc8a..6eb086aa14d 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -581,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical records." (list (car (sort components - #'(lambda (a b) - (let* ((get-recent (lambda (n) - (car - (sort - (delq nil - (mapcar (lambda (p) - (and (memq (car p) '(DTSTART RDATE)) - (car (cddr p)))) - n)) - 'string-greaterp)))) - (a-recent (funcall get-recent (car (cddr a)))) - (b-recent (funcall get-recent (car (cddr b))))) - (string-greaterp a-recent b-recent)))))))) + (lambda (a b) + (let* ((get-recent (lambda (n) + (car + (sort + (delq nil + (mapcar (lambda (p) + (and (memq (car p) '(DTSTART RDATE)) + (car (cddr p)))) + n)) + 'string-greaterp)))) + (a-recent (funcall get-recent (car (cddr a)))) + (b-recent (funcall get-recent (car (cddr b))))) + (string-greaterp a-recent b-recent)))))))) (defun icalendar--convert-all-timezones (icalendar) "Convert all timezones in the ICALENDAR into an alist. diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index aa3236cf256..5a3d2706afd 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -103,46 +103,46 @@ letters, digits, plus or minus signs or colons." ((4) parse-time-months) ((5) (100)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 8) - (= (aref parse-time-elt 2) ?:) - (= (aref parse-time-elt 5) ?:))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 8) + (= (aref parse-time-elt 2) ?:) + (= (aref parse-time-elt 5) ?:))) [0 2] [3 5] [6 8]) ((8 7) parse-time-zoneinfo - ,#'(lambda () (car parse-time-val)) - ,#'(lambda () (cadr parse-time-val))) + ,(lambda () (car parse-time-val)) + ,(lambda () (cadr parse-time-val))) ((8) - ,#'(lambda () - (and (stringp parse-time-elt) - (= 5 (length parse-time-elt)) - (or (= (aref parse-time-elt 0) ?+) - (= (aref parse-time-elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) - (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) - (if (= (aref parse-time-elt 0) ?-) -1 1)))) + ,(lambda () + (and (stringp parse-time-elt) + (= 5 (length parse-time-elt)) + (or (= (aref parse-time-elt 0) ?+) + (= (aref parse-time-elt 0) ?-)))) + ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) + (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) + (if (= (aref parse-time-elt 0) ?-) -1 1)))) ((5 4 3) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 10) - (= (aref parse-time-elt 4) ?-) - (= (aref parse-time-elt 7) ?-))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 10) + (= (aref parse-time-elt 4) ?-) + (= (aref parse-time-elt 7) ?-))) [0 4] [5 7] [8 10]) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 5) - (= (aref parse-time-elt 2) ?:))) - [0 2] [3 5] ,#'(lambda () 0)) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 5) + (= (aref parse-time-elt 2) ?:))) + [0 2] [3 5] ,(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 4) - (= (aref parse-time-elt 1) ?:))) - [0 1] [2 4] ,#'(lambda () 0)) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 4) + (= (aref parse-time-elt 1) ?:))) + [0 1] [2 4] ,(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 7) - (= (aref parse-time-elt 1) ?:))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 7) + (= (aref parse-time-elt 1) ?:))) [0 1] [2 4] [5 7]) - ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) - ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) + ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt))) + ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt)))) "(slots predicate extractor...)") ;;;###autoload(put 'parse-time-rules 'risky-local-variable t) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 78950159199..c6bf15205fd 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return non-nil if the minor mode is enabled." ;; ;;\\{semantic-decoration-map}" - nil nil nil + :lighter nil (if semantic-decoration-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index dba289fdd75..4c3bb6c238b 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -31,7 +31,12 @@ (require 'semantic/format) ;; FIXME this is a generated file, but we need to load this file to ;; generate it! -(require 'semantic/grammar-wy) +;; We need `semantic/grammar-wy.el' but we're also needed to generate +;; that file from `grammar.wy', so to break the dependency, we keep +;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008. +(eval-and-compile + (unless (require 'semantic/grammar-wy nil t) + (load "semantic/grm-wy-boot"))) (require 'semantic/idle) (require 'help-fns) (require 'semantic/analyze) diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grm-wy-boot.el index b3014034374..b3014034374 100644 --- a/lisp/cedet/semantic/grammar-wy.el +++ b/lisp/cedet/semantic/grm-wy-boot.el diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 420a457b0ea..b883573a30f 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -171,7 +171,8 @@ date, and reparses while the user is idle (not typing.) The minor mode can be turned on only if semantic feature is available and the current buffer was set up for parsing. Return -non-nil if the minor mode is enabled." nil nil nil +non-nil if the minor mode is enabled." + :lighter nil (if semantic-idle-scheduler-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d43cdb15c0d..18087da9ac9 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -1,7 +1,6 @@ -;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el +;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988-2021 Free Software Foundation, Inc. ;; Author: Olin Shivers <olin.shivers@cs.cmu.edu> ;; Maintainer: emacs-devel@gnu.org @@ -26,20 +25,18 @@ ;; This is a customization of comint-mode (see comint.el) ;; -;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces +;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces ;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al.. ;; 8/88 ;; ;; Please send me bug reports, bug fixes, and extensions, so that I can ;; merge them into the master source. ;; -;; The changelog is at the end of this file. -;; ;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user ;; interface that communicates process state back to the superior emacs by -;; outputting special control sequences. The Emacs package, xscheme.el, has +;; outputting special control sequences. The Emacs package, xscheme.el, has ;; lots and lots of special purpose code to read these control sequences, and -;; so is very tightly integrated with the cscheme process. The cscheme +;; so is very tightly integrated with the cscheme process. The cscheme ;; interrupt handler and debugger read single character commands in cbreak ;; mode; when this happens, xscheme.el switches to special keymaps that bind ;; the single letter command keys to emacs functions that directly send the @@ -49,18 +46,18 @@ ;; ;; Here's a summary of the pros and cons, as I see them. ;; xscheme: Tightly integrated with inferior cscheme process! A few commands -;; not in cmuscheme. But. Integration is a bit of a hack. Input -;; history only keeps the immediately prior input. Bizarre +;; not in cmuscheme. But. Integration is a bit of a hack. Input +;; history only keeps the immediately prior input. Bizarre ;; keybindings. ;; ;; cmuscheme: Not tightly integrated with inferior cscheme process. But. ;; Carefully integrated functionality with the entire suite of -;; comint-derived CMU process modes. Keybindings reminiscent of -;; Zwei and Hemlock. Good input history. A few commands not in +;; comint-derived CMU process modes. Keybindings reminiscent of +;; Zwei and Hemlock. Good input history. A few commands not in ;; xscheme. ;; -;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme -;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* +;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme +;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* ;; Cscheme-specific; you must use cmuscheme.el. Interested parties are ;; invited to port xscheme functionality on top of comint mode... @@ -70,18 +67,18 @@ ;; Created. ;; ;; 2/15/89 Olin -;; Removed -emacs flag from process invocation. It's only useful for +;; Removed -emacs flag from process invocation. It's only useful for ;; cscheme, and makes cscheme assume it's running under xscheme.el, -;; which messes things up royally. A bug. +;; which messes things up royally. A bug. ;; ;; 5/22/90 Olin ;; - Upgraded to use comint-send-string and comint-send-region. ;; - run-scheme now offers to let you edit the command line if -;; you invoke it with a prefix-arg. M-x scheme is redundant, and +;; you invoke it with a prefix-arg. M-x scheme is redundant, and ;; has been removed. ;; - Explicit references to process "scheme" have been replaced with -;; (scheme-proc). This allows better handling of multiple process bufs. -;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. +;; (scheme-proc). This allows better handling of multiple process bufs. +;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. ;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist ;; and friends, but interested hackers might find a useful application ;; of this facility. @@ -95,42 +92,37 @@ (require 'scheme) (require 'comint) - (defgroup cmuscheme nil "Run a scheme process in a buffer." :group 'scheme) -;;; INFERIOR SCHEME MODE STUFF -;;;============================================================================ - (defcustom inferior-scheme-mode-hook nil "Hook for customizing inferior-scheme mode." - :type 'hook - :group 'cmuscheme) + :type 'hook) (defvar inferior-scheme-mode-map (let ((m (make-sparse-keymap))) - (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention - (define-key m "\C-x\C-e" 'scheme-send-last-sexp) - (define-key m "\C-c\C-l" 'scheme-load-file) - (define-key m "\C-c\C-k" 'scheme-compile-file) + (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention + (define-key m "\C-x\C-e" #'scheme-send-last-sexp) + (define-key m "\C-c\C-l" #'scheme-load-file) + (define-key m "\C-c\C-k" #'scheme-compile-file) (scheme-mode-commands m) m)) ;; Install the process communication commands in the scheme-mode keymap. -(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention -(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention -(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition) -(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) -(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) -(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) -(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) -(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) -(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure) -(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form) -(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) -(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) -(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" +(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention +(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention +(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition) +(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go) +(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region) +(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go) +(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition) +(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go) +(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure) +(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form) +(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme) +(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file) +(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile" (let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) (define-key map [separator-eval] '("--")) @@ -157,8 +149,7 @@ (define-key map [send-region] '("Evaluate Region" . scheme-send-region)) (define-key map [send-sexp] - '("Evaluate Last S-expression" . scheme-send-last-sexp)) - ) + '("Evaluate Last S-expression" . scheme-send-last-sexp))) (defvar scheme-buffer) @@ -209,8 +200,7 @@ to continue it." (defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" "Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters." - :type 'regexp - :group 'cmuscheme) + :type 'regexp) (defun scheme-input-filter (str) "Don't save anything matching `inferior-scheme-filter-regexp'." @@ -242,7 +232,7 @@ is run). scheme-program-name))) (if (not (comint-check-proc "*scheme*")) (let ((cmdlist (split-string-and-unquote cmd))) - (set-buffer (apply 'make-comint "scheme" (car cmdlist) + (set-buffer (apply #'make-comint "scheme" (car cmdlist) (scheme-start-file (car cmdlist)) (cdr cmdlist))) (inferior-scheme-mode))) (setq scheme-program-name cmd) @@ -282,8 +272,7 @@ in this order. Return nil if no start file found." (defcustom scheme-compile-exp-command "(compile '%s)" "Template for issuing commands to compile arbitrary Scheme expressions." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-compile-region (start end) "Compile the current region in the inferior Scheme process. @@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\") For Scheme 48 and Scsh use \",trace %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defcustom scheme-untrace-command "(untrace %s)" "Template for switching off tracing of a Scheme procedure. Scheme 48 and Scsh users should set this variable to \",untrace %s\"." - - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-trace-procedure (proc &optional untrace) "Trace procedure PROC in the inferior Scheme process. @@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC." (defcustom scheme-macro-expand-command "(expand %s)" "Template for macro-expanding a Scheme form. For Scheme 48 and Scsh use \",expand %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-expand-current-form () "Macro-expand the form at point in the inferior Scheme process." @@ -410,8 +395,7 @@ Then switch to the process buffer." If it's loaded into a buffer that is in one of these major modes, it's considered a scheme source file by `scheme-load-file' and `scheme-compile-file'. Used by these commands to determine defaults." - :type '(repeat function) - :group 'cmuscheme) + :type '(repeat function)) (defvar scheme-prev-l/c-dir/file nil "Caches the last (directory . file) pair. @@ -514,8 +498,7 @@ command to run." (defcustom cmuscheme-load-hook nil "This hook is run when cmuscheme is loaded in. This is a good place to put keybindings." - :type 'hook - :group 'cmuscheme) + :type 'hook) (make-obsolete-variable 'cmuscheme-load-hook "use `with-eval-after-load' instead." "28.1") diff --git a/lisp/comint.el b/lisp/comint.el index b04d404676d..ef34174305f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1627,7 +1627,6 @@ or to the last history element for a backward search." (if isearch-forward (comint-goto-input (1- (ring-length comint-input-ring))) (comint-goto-input nil)) - (setq isearch-success t) (goto-char (if isearch-forward (comint-line-beginning-position) (point-max)))) (defun comint-history-isearch-push-state () @@ -1798,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil." (min size (- comint-input-ring-size size))))) (ring-insert comint-input-ring cmd))) +(defconst comint--prompt-rear-nonsticky + '(field inhibit-line-move-field-capture read-only font-lock-face) + "Text properties we set on the prompt and don't want to leak past it.") + (defun comint-send-input (&optional no-newline artificial) "Send input to process. After the process output mark, sends all text from the process mark to @@ -1917,7 +1920,8 @@ Similarly for Soar, Scheme, etc." (unless (or no-newline comint-use-prompt-regexp) ;; Cover the terminating newline (add-text-properties end (1+ end) - '(rear-nonsticky t + `(rear-nonsticky + ,comint--prompt-rear-nonsticky field boundary inhibit-line-move-field-capture t))))) @@ -2124,9 +2128,10 @@ Make backspaces delete the previous character." (unless comint-use-prompt-regexp (with-silent-modifications (add-text-properties comint-last-output-start (point) - '(front-sticky + `(rear-nonsticky + ,comint--prompt-rear-nonsticky + front-sticky (field inhibit-line-move-field-capture) - rear-nonsticky t field output inhibit-line-move-field-capture t)))) @@ -2155,7 +2160,9 @@ Make backspaces delete the previous character." (font-lock-prepend-text-property prompt-start (point) 'font-lock-face 'comint-highlight-prompt) - (add-text-properties prompt-start (point) '(rear-nonsticky t))) + (add-text-properties prompt-start (point) + `(rear-nonsticky + ,comint--prompt-rear-nonsticky))) (goto-char saved-point))))))) (defun comint-preinput-scroll-to-bottom () @@ -2251,23 +2258,23 @@ This function could be on `comint-output-filter-functions' or bound to a key." (let ((inhibit-read-only t)) (delete-region (point-min) (point))))) -(defun comint-strip-ctrl-m (&optional _string) +(defun comint-strip-ctrl-m (&optional _string interactive) "Strip trailing `^M' characters from the current output group. This function could be on `comint-output-filter-functions' or bound to a key." - (interactive) + (interactive (list nil t)) (let ((process (get-buffer-process (current-buffer)))) (if (not process) ;; This function may be used in ;; `comint-output-filter-functions', and in that case, if ;; there's no process, then we should do nothing. If ;; interactive, report an error. - (when (called-interactively-p 'interactive) + (when interactive (error "No process in the current buffer")) (let ((pmark (process-mark process))) (save-excursion (condition-case nil (goto-char - (if (called-interactively-p 'interactive) + (if interactive comint-last-input-end comint-last-output-start)) (error nil)) (while (re-search-forward "\r+$" pmark t) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index e2b73513bd5..31a896088a5 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -1,4 +1,4 @@ -;;; cus-dep.el --- find customization dependencies +;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*- ;; ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. ;; @@ -132,7 +132,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" 'custom-where name) ;; Eval to get the 'custom-group, -tag, ;; -version, group-documentation etc properties. - (eval expr)) + (eval expr t)) ;; Eval failed for some reason. Eg maybe the ;; defcustom uses something defined earlier ;; in the file (we haven't loaded the file). @@ -164,7 +164,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (let ((members (get symbol 'custom-group)) where found) (when members - (dolist (member (mapcar 'car members)) + (dolist (member (mapcar #'car members)) (setq where (get member 'custom-where)) (unless (or (null where) (member where found)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d5f49108767..8fe612fa0b1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2980,7 +2980,7 @@ a file name. Otherwise, it searches the whole buffer without restrictions." When on, Isearch skips matches outside file names using the predicate `dired-isearch-filter-filenames' that matches only at file names. When off, it uses the original predicate." - nil nil nil + :lighter nil (if dired-isearch-filenames-mode (add-function :before-while (local 'isearch-filter-predicate) #'dired-isearch-filter-filenames diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 7f76ef6653a..be8db75c967 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -184,7 +184,7 @@ working directory at all times, and that you set the variable This is an alternative to `shell-dirtrack-mode', which works by tracking `cd' and similar commands which change the shell working directory." - nil nil nil + :lighter nil (if dirtrack-mode (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) @@ -192,7 +192,7 @@ directory." (define-minor-mode dirtrack-debug-mode "Toggle Dirtrack debugging." - nil nil nil + :lighter nil (if dirtrack-debug-mode (display-buffer (get-buffer-create dirtrack-debug-buffer)))) diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 39d2a1d1e2a..6b037aa2a6c 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -24,8 +24,8 @@ ;;; Commentary: -;; This file provides the lisp part of the GConf and XSetting code in -;; xsetting.c. But it is nothing that prevents it from being used by +;; This file provides the Lisp part of the GConf and XSetting code in +;; xsetting.c. But there is nothing that prevents it from being used by ;; other configuration schemes. ;;; Code: @@ -92,3 +92,6 @@ Changes can be (define-key special-event-map [config-changed-event] #'dynamic-setting-handle-config-changed-event) + +(provide 'dynamic-setting) +;;; dynamic-setting.el ends here diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 3d7db44a86d..84de69a2ce1 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -1,4 +1,4 @@ -;;; edmacro.el --- keyboard macro editor +;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation." (defvar edmacro-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'edmacro-finish-edit) - (define-key map "\C-c\C-q" 'edmacro-insert-key) + (define-key map "\C-c\C-c" #'edmacro-finish-edit) + (define-key map "\C-c\C-q" #'edmacro-insert-key) map)) (defvar edmacro-store-hook) @@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way." (set-buffer-modified-p nil)) (run-hooks 'edmacro-format-hook))))) -;;; The next two commands are provided for convenience and backward -;;; compatibility. +;; The next two commands are provided for convenience and backward +;; compatibility. ;;;###autoload (defun edit-last-kbd-macro (&optional prefix) @@ -237,8 +237,7 @@ or nil, use a compact 80-column format." ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Command\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq cmd (and (not (equal str "none")) (intern str))) @@ -253,8 +252,7 @@ or nil, use a compact 80-column format." (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) (let ((key (edmacro-parse-keys - (buffer-substring (match-beginning 1) - (match-end 1))))) + (match-string 1)))) (unless (equal key "") (if (equal key "none") (setq no-keys t) @@ -274,16 +272,14 @@ or nil, use a compact 80-column format." ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Counter\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-counter (string-to-number str)))) t) ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") (when edmacro-store-hook (error "\"Format\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-format str))) t) @@ -475,7 +471,7 @@ doubt, use whitespace." (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") (cl-callf cl-subseq rest-mac i))))))) - (bind-len (apply 'max 1 + (bind-len (apply #'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) @@ -506,7 +502,7 @@ doubt, use whitespace." finally return i)) desc) (if (stringp bind) (setq bind nil)) - (cond ((and (eq bind 'self-insert-command) (not prefix) + (cond ((and (eq bind #'self-insert-command) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn @@ -520,11 +516,11 @@ doubt, use whitespace." desc)))) (when (or (string-match "^\\^.$" desc) (member desc res-words)) - (setq desc (mapconcat 'char-to-string desc " "))) + (setq desc (mapconcat #'char-to-string desc " "))) (when verbose (setq bind (format "%s * %d" bind text))) (setq bind-len text)) - ((and (eq bind 'execute-extended-command) + ((and (eq bind #'execute-extended-command) (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn @@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string." (substring word 2 -2) "\r"))) ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) (progn - (setq word (concat (substring word (match-beginning 1) - (match-end 1)) - (substring word (match-beginning 3) - (match-end 3)))) + (setq word (concat (match-string 1 word) + (match-string 3 word))) (not (string-match "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" word)))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 436f5e48ae1..51b2f9bb98d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) + (let ((byte-optimize--lexvars + (and lexical-binding + (if var + (cons (list var t) + byte-optimize--lexvars) + byte-optimize--lexvars)))) + (cons (car clause) + (byte-optimize-body (cdr clause) for-effect)))) clauses)))) (`(unwind-protect ,exp . ,exps) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index afaa13a8695..b37cfebab31 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -498,7 +498,7 @@ places where they originally did not directly appear." (let* ((class (and var (cconv--var-classification (list var) form))) (newenv (cond ((eq class :captured+mutated) - (cons `(,var . (car-save ,var)) env)) + (cons `(,var . (car-safe ,var)) env)) ((assq var env) (cons `(,var) env)) (t env))) (msg (when (eq class :unused) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 96b16f7ed45..00cc7777e1a 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1242,7 +1242,7 @@ bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-c checking of documentation strings. \\{checkdoc-minor-mode-map}" - nil checkdoc-minor-mode-string nil + :lighter checkdoc-minor-mode-string :group 'checkdoc) ;;; Subst utils diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7f8f7105f33..8b2d3c413af 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones. ;; tail-called any more. (not (memq var shadowings))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) + ((and `(condition-case ,err-var ,bodyform . ,handlers) + (guard (not (eq err-var var)))) + `(condition-case ,err-var + (progn (setq ,retvar ,bodyform) nil) + . ,(mapcar (lambda (h) + (cons (car h) (funcall opt-exps (cdr h)))) + handlers))) ('nil nil) ;No need to set `retvar' to return nil. (_ `(progn (setq ,retvar ,exp) nil)))))) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index addb58cdbbe..e23ff5ae513 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -139,39 +139,31 @@ documenting what its argument does. If the word \"ARG\" does not appear in DOC, a paragraph is added to DOC explaining usage of the mode argument. -Optional INIT-VALUE is the initial value of the mode's variable. - Note that the minor mode function won't be called by setting - this option, so the value *reflects* the minor mode's natural - initial state, rather than *setting* it. - In the vast majority of cases it should be nil. -Optional LIGHTER is displayed in the mode line when the mode is on. -Optional KEYMAP is the default keymap bound to the mode keymap. - If non-nil, it should be a variable name (whose value is a keymap), - or an expression that returns either a keymap or a list of - (KEY . BINDING) pairs where KEY and BINDING are suitable for - `define-key'. If you supply a KEYMAP argument that is not a - symbol, this macro defines the variable MODE-map and gives it - the value that KEYMAP specifies. - BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. Before the actual body code, you can write keyword arguments, i.e. alternating keywords and values. If you provide BODY, then you must - provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide - at least one keyword argument, or both; otherwise, BODY would be - misinterpreted as the first omitted argument. The following special + provide at least one keyword argument. The following special keywords are supported (other keywords are passed to `defcustom' if the minor mode is global): -:group GROUP Custom group name to use in all generated `defcustom' forms. :global GLOBAL If non-nil specifies that the minor mode is not meant to be buffer-local, so don't make the variable MODE buffer-local. By default, the mode is buffer-local. -:init-value VAL Same as the INIT-VALUE argument. +:init-value VAL the initial value of the mode's variable. + Note that the minor mode function won't be called by setting + this option, so the value *reflects* the minor mode's natural + initial state, rather than *setting* it. + In the vast majority of cases it should be nil. Not used if you also specify :variable. -:lighter SPEC Same as the LIGHTER argument. -:keymap MAP Same as the KEYMAP argument. -:require SYM Same as in `defcustom'. +:lighter SPEC Text displayed in the mode line when the mode is on. +:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'. + If non-nil, it should be a variable name (whose value is + a keymap), or an expression that returns either a keymap or + a list of (KEY . BINDING) pairs where KEY and BINDING are + suitable for `define-key'. If you supply a KEYMAP argument + that is not a symbol, this macro defines the variable MODE-map + and gives it the value that KEYMAP specifies. :interactive VAL Whether this mode should be a command or not. The default is to make it one; use nil to avoid that. If VAL is a list, it's interpreted as a list of major modes this minor mode @@ -185,15 +177,18 @@ BODY contains code to execute each time the mode is enabled or disabled. sets it. If you specify a :variable, this function does not define a MODE variable (nor any of the terms used in :variable). - :after-hook A single lisp form which is evaluated after the mode hooks have been run. It should not be quoted. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" :lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\" - ...BODY CODE...)" + ...BODY CODE...) + +For backward compatibility with the Emacs<21 calling convention, +BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP." (declare (doc-string 2) + (advertised-calling-convention (mode doc &rest body) "28.1") (debug (&define name string-or-null-p [&optional [¬ keywordp] sexp &optional [¬ keywordp] sexp @@ -201,23 +196,12 @@ For example, you could write [&rest [keywordp sexp]] def-body))) - ;; Allow skipping the first three args. - (cond - ((keywordp init-value) - (setq body (if keymap `(,init-value ,lighter ,keymap ,@body) - `(,init-value ,lighter)) - init-value nil lighter nil keymap nil)) - ((keywordp lighter) - (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil)) - ((keywordp keymap) (push keymap body) (setq keymap nil))) - (let* ((last-message (make-symbol "last-message")) (mode-name (symbol-name mode)) - (pretty-name (easy-mmode-pretty-mode-name mode lighter)) + (pretty-name nil) (globalp nil) (set nil) (initialize nil) - (group nil) (type nil) (extra-args nil) (extra-keywords nil) @@ -225,14 +209,28 @@ For example, you could write (setter `(setq ,mode)) ;The beginning of the exp to set the mode var. (getter mode) ;The exp to get the mode value. (modefun mode) ;The minor mode function name we're defining. - (require t) (after-hook nil) (hook (intern (concat mode-name "-hook"))) (hook-on (intern (concat mode-name "-on-hook"))) (hook-off (intern (concat mode-name "-off-hook"))) (interactive t) + (warnwrap (if (keywordp init-value) #'identity + (lambda (exp) + (macroexp-warn-and-return + "Use keywords rather than deprecated positional arguments to `define-minor-mode'" + exp)))) keyw keymap-sym tmp) + ;; Allow skipping the first three args. + (cond + ((keywordp init-value) + (setq body (if keymap `(,init-value ,lighter ,keymap ,@body) + `(,init-value ,lighter)) + init-value nil lighter nil keymap nil)) + ((keywordp lighter) + (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil)) + ((keywordp keymap) (push keymap body) (setq keymap nil))) + ;; Check keys. (while (keywordp (setq keyw (car body))) (setq body (cdr body)) @@ -246,9 +244,7 @@ For example, you could write (:extra-args (setq extra-args (pop body))) (:set (setq set (list :set (pop body)))) (:initialize (setq initialize (list :initialize (pop body)))) - (:group (setq group (nconc group (list :group (pop body))))) (:type (setq type (list :type (pop body)))) - (:require (setq require (pop body))) (:keymap (setq keymap (pop body))) (:interactive (setq interactive (pop body))) (:variable (setq variable (pop body)) @@ -264,6 +260,7 @@ For example, you could write (:after-hook (setq after-hook (pop body))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) + (setq pretty-name (easy-mmode-pretty-mode-name mode lighter)) (setq keymap-sym (if (and keymap (symbolp keymap)) keymap (intern (concat mode-name "-map")))) @@ -301,70 +298,72 @@ or call the function `%s'.")))) ,(format base-doc-string pretty-name mode mode) ,@set ,@initialize - ,@group ,@type - ,@(unless (eq require t) `(:require ,require)) ,@(nreverse extra-keywords))))) ;; The actual function. - (defun ,modefun (&optional arg ,@extra-args) - ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) - ,(when interactive - ;; Use `toggle' rather than (if ,mode 0 1) so that using - ;; repeat-command still does the toggling correctly. - (if (consp interactive) - `(interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle)) - ,@interactive) - '(interactive (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))))) - (let ((,last-message (current-message))) - (,@setter - (cond ((eq arg 'toggle) - (not ,getter)) - ((and (numberp arg) - (< arg 1)) - nil) - (t - t))) - ;; Keep minor modes list up to date. - ,@(if globalp - ;; When running this byte-compiled code in earlier - ;; Emacs versions, these variables may not be defined - ;; there. So check defensively, even if they're - ;; always defined in Emacs 28 and up. - `((when (boundp 'global-minor-modes) - (setq global-minor-modes - (delq ',modefun global-minor-modes)) - (when ,getter - (push ',modefun global-minor-modes)))) - ;; Ditto check. - `((when (boundp 'local-minor-modes) - (setq local-minor-modes (delq ',modefun local-minor-modes)) - (when ,getter - (push ',modefun local-minor-modes))))) - ,@body - ;; The on/off hooks are here for backward compatibility only. - (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) - (if (called-interactively-p 'any) - (progn - ,(if (and globalp (not variable)) - `(customize-mark-as-set ',mode)) - ;; Avoid overwriting a message shown by the body, - ;; but do overwrite previous messages. - (unless (and (current-message) - (not (equal ,last-message - (current-message)))) - (let ((local ,(if globalp "" " in current buffer"))) - (message ,(format "%s %%sabled%%s" pretty-name) - (if ,getter "en" "dis") local))))) - ,@(when after-hook `(,after-hook))) - (force-mode-line-update) - ;; Return the new setting. - ,getter) + ,(funcall + warnwrap + `(defun ,modefun (&optional arg ,@extra-args) + ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) + ,(when interactive + ;; Use `toggle' rather than (if ,mode 0 1) so that using + ;; repeat-command still does the toggling correctly. + (if (consp interactive) + `(interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle)) + ,@interactive) + '(interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))))) + (let ((,last-message (current-message))) + (,@setter + (cond ((eq arg 'toggle) + (not ,getter)) + ((and (numberp arg) + (< arg 1)) + nil) + (t + t))) + ;; Keep minor modes list up to date. + ,@(if globalp + ;; When running this byte-compiled code in earlier + ;; Emacs versions, these variables may not be defined + ;; there. So check defensively, even if they're + ;; always defined in Emacs 28 and up. + `((when (boundp 'global-minor-modes) + (setq global-minor-modes + (delq ',modefun global-minor-modes)) + (when ,getter + (push ',modefun global-minor-modes)))) + ;; Ditto check. + `((when (boundp 'local-minor-modes) + (setq local-minor-modes + (delq ',modefun local-minor-modes)) + (when ,getter + (push ',modefun local-minor-modes))))) + ,@body + ;; The on/off hooks are here for backward compatibility only. + (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) + (if (called-interactively-p 'any) + (progn + ,(if (and globalp (not variable)) + `(customize-mark-as-set ',mode)) + ;; Avoid overwriting a message shown by the body, + ;; but do overwrite previous messages. + (unless (and (current-message) + (not (equal ,last-message + (current-message)))) + (let ((local ,(if globalp "" " in current buffer"))) + (message ,(format "%s %%sabled%%s" pretty-name) + (if ,getter "en" "dis") local))))) + ,@(when after-hook `(,after-hook))) + (force-mode-line-update) + ;; Return the new setting. + ,getter)) ;; Autoloading a define-minor-mode autoloads everything ;; up-to-here. diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 87b34e7cd57..f6661541a16 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -494,14 +494,16 @@ To implement dynamic menus, either call this from `menu-bar-update-hook' or use a menu filter." (easy-menu-add-item map path (easy-menu-create-menu name items) before)) -(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1" +(defalias 'easy-menu-remove #'ignore "Remove MENU from the current menu bar. Contrary to XEmacs, this is a nop on Emacs since menus are automatically \(de)activated when the corresponding keymap is (de)activated. \(fn MENU)") +(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \ +and can be safely removed." "28.1") -(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1" +(defalias 'easy-menu-add #'ignore "Add the menu to the menubar. On Emacs this is a nop, because menus are already automatically activated when the corresponding keymap is activated. On XEmacs @@ -511,6 +513,8 @@ You should call this once the menu and keybindings are set up completely and menu filter functions can be expected to work. \(fn MENU &optional MAP)") +(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \ +and can be safely removed." "28.1") (defun add-submenu (menu-path submenu &optional before in-menu) "Add submenu SUBMENU in the menu at MENU-PATH. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f1455ffe73b..cbc40193125 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1942,14 +1942,16 @@ a sequence of elements." ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder ;; of the current list. e.g. ("lambda" &define args def-body) - (edebug-make-form-wrapper - cursor - (edebug-before-offset cursor) - ;; Find the last offset in the list. - (let ((offsets (edebug-cursor-offsets cursor))) - (while (consp offsets) (setq offsets (cdr offsets))) - offsets) - specs)) + (prog1 (edebug-make-form-wrapper + cursor + (edebug-before-offset cursor) + ;; Find the last offset in the list. + (let ((offsets (edebug-cursor-offsets cursor))) + (while (consp offsets) (setq offsets (cdr offsets))) + offsets) + specs) + ;; Stop backtracking here (Bug#41988). + (setq edebug-gate t))) (cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. @@ -4114,12 +4116,12 @@ This should be a list of `edebug---frame' objects.") "Stack frames of the current Edebug Backtrace buffer with instrumentation. This should be a list of `edebug---frame' objects.") -;; Data structure for backtrace frames with information -;; from Edebug instrumentation found in the backtrace. (cl-defstruct (edebug--frame (:constructor edebug--make-frame) (:include backtrace-frame)) + "Data structure for backtrace frames with information +from Edebug instrumentation found in the backtrace." def-name before-index after-index) (defun edebug-pop-to-backtrace () diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index ec1077d447e..641882c9026 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,7 +1,6 @@ ;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- -;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software -;;; Foundation, Inc. +;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: OO, lisp diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index 4256bd59584..0e86b923c4a 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -31,6 +31,7 @@ (with-suppressed-warnings ((lexical pi)) (defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.")) +(make-obsolete-variable 'pi 'float-pi "23.3") (internal-make-var-non-special 'pi) (defconst float-e (exp 1) "The value of e (2.7182818...).") diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 59ada5ec35a..df864464b77 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -394,7 +394,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; Record which arguments expect functions, so we can warn when those ;; are accidentally quoted with ' rather than with #' -(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash)) +(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash + map-char-table map-keymap map-keymap-internal)) (put f 'funarg-positions '(1))) (dolist (f '( add-hook remove-hook advice-remove advice--remove-function defalias fset global-set-key run-after-idle-timeout diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index ecbca280e59..f4f03133b0f 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -182,7 +182,7 @@ by counted more than once." (cl-defmethod memory-report--object-size-1 (_ (value symbol)) ;; Don't count global symbols -- makes sizes of lists of symbols too - ;; heavey. + ;; heavy. (if (intern-soft value obarray) 0 (memory-report--size 'symbol))) @@ -214,14 +214,14 @@ by counted more than once." (setf (gethash value counted) t) (when (car value) (cl-incf total (memory-report--object-size counted (car value)))) - (if (cdr value) - (if (consp (cdr value)) - (if (gethash (cdr value) counted) - (setq value nil) - (setq value (cdr value))) - (cl-incf total (memory-report--object-size counted (cdr value))) - (setq value nil)) - (setq value nil))) + (let ((next (cdr value))) + (setq value (when next + (if (consp next) + (unless (gethash next counted) + (cdr value)) + (cl-incf total (memory-report--object-size + counted next)) + nil))))) total)) (cl-defmethod memory-report--object-size-1 (counted (value vector)) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 994433063ce..ab3cb3c5ace 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -57,7 +57,7 @@ ;; ;; SMIE: Weakness is Power! Auto-indentation with incomplete information ;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1. -;; doi: 10.22152/programming-journal.org/2020/5/1 +;; doi: 10.22152/programming-journal.org/2021/5/1 ;; A good background to understand the development (especially the parts ;; building the 2D precedence tables and then computing the precedence levels @@ -68,7 +68,7 @@ ;; OTOH we had to kill many chickens, read many coffee grounds, and practice ;; untold numbers of black magic spells, to come up with the indentation code. ;; Since then, some of that code has been beaten into submission, but the -;; smie-indent-keyword is still pretty obscure. +;; `smie-indent-keyword' function is still pretty obscure. ;; Conflict resolution: @@ -247,7 +247,7 @@ be either: ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in ;; the repetition, maybe). - (let* ((nts (mapcar 'car bnf)) ;Non-terminals. + (let* ((nts (mapcar #'car bnf)) ;Non-terminals. (first-ops-table ()) (last-ops-table ()) (first-nts-table ()) @@ -266,7 +266,7 @@ be either: (push resolver precs)) (t (error "Unknown resolver %S" resolver)))) (apply #'smie-merge-prec2s over - (mapcar 'smie-precs->prec2 precs)))) + (mapcar #'smie-precs->prec2 precs)))) again) (dolist (rules bnf) (let ((nt (car rules)) @@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph." res)) cycle))) (mapconcat - (lambda (elems) (mapconcat 'identity elems "=")) + (lambda (elems) (mapconcat #'identity elems "=")) (append names (list (car names))) " < "))) @@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; Then eliminate trivial constraints iteratively. (let ((i 0)) (while csts - (let ((rhvs (mapcar 'cdr csts)) + (let ((rhvs (mapcar #'cdr csts)) (progress nil)) (dolist (cst csts) (unless (memq (car cst) rhvs) @@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.") Same calling convention as `smie-forward-token-function' except it should move backward to the beginning of the previous token.") -(defalias 'smie-op-left 'car) -(defalias 'smie-op-right 'cadr) +(defalias 'smie-op-left #'car) +(defalias 'smie-op-right #'cadr) (defun smie-default-backward-token () (forward-comment (- (point))) @@ -974,8 +974,7 @@ I.e. a good choice can be: (defcustom smie-blink-matching-inners t "Whether SMIE should blink to matching opener for inner keywords. If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." - :type 'boolean - :group 'smie) + :type 'boolean) (defun smie-blink-matching-check (start end) (save-excursion @@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." (defcustom smie-indent-basic 4 "Basic amount of indentation." - :type 'integer - :group 'smie) + :type 'integer) (defvar smie-rules-function #'ignore "Function providing the indentation rules. @@ -1189,7 +1187,7 @@ designed specifically for use in this function.") (and ;; (looking-at comment-start-skip) ;(bug#16041). (forward-comment (point-max)))))) -(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) +(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p) (defun smie-indent--hanging-p () "Return non-nil if the current token is \"hanging\". A hanging keyword is one that's at the end of a line except it's not at @@ -1205,7 +1203,7 @@ the beginning of a line." (funcall smie--hanging-eolp-function) (point)))))) -(defalias 'smie-rule-bolp 'smie-indent--bolp) +(defalias 'smie-rule-bolp #'smie-indent--bolp) (defun smie-indent--bolp () "Return non-nil if the current token is the first on the line." (save-excursion (skip-chars-backward " \t") (bolp))) @@ -1421,7 +1419,7 @@ BASE-POS is the position relative to which offsets should be applied." (forward-sexp 1) nil) ((eobp) nil) - (t (error "Bumped into unknown token"))))) + (t (error "Bumped into unknown token: %S" tok))))) (defun smie-indent-backward-token () "Skip token backward and return it, along with its levels." @@ -1810,9 +1808,11 @@ Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column to which that point should be aligned, if we were to reindent it.") +(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection. + (defun smie-indent-calculate () "Compute the indentation to use for point." - (run-hook-with-args-until-success 'smie-indent-functions)) + (run-hook-wrapped 'smie-indent-functions #'smie--funcall)) (defun smie-indent-line () "Indent current line using the SMIE indentation engine." @@ -2016,7 +2016,7 @@ value with which to replace it." ;; FIXME improve value-type. :type '(choice (const nil) (alist :key-type symbol)) - :initialize 'custom-initialize-set + :initialize #'custom-initialize-set :set #'smie-config--setter) (defun smie-config-local (rules) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0c299b48b90..0b10dfdc0af 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -410,8 +410,7 @@ specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. Optional argument REMEMBER-POS, if non-nil, means to move point -to the entry with the same ID element as the current line and -recenter window line accordingly. +to the entry with the same ID element as the current line. Non-nil UPDATE argument means to use an alternative printing method which is faster if most entries haven't changed since the @@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'." (funcall tabulated-list-entries) tabulated-list-entries)) (sorter (tabulated-list--get-sorter)) - entry-id saved-pt saved-col window-line) + entry-id saved-pt saved-col) (and remember-pos (setq entry-id (tabulated-list-get-id)) - (setq saved-col (current-column)) - (when (eq (window-buffer) (current-buffer)) - (setq window-line - (save-excursion - (save-restriction - (widen) - (narrow-to-region (window-start) (point)) - (goto-char (point-min)) - (vertical-motion (buffer-size))))))) + (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter (setq entries (sort entries sorter))) @@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'." ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt (progn (goto-char saved-pt) - (move-to-column saved-col) - (when window-line - (recenter window-line))) + (move-to-column saved-col)) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index e46e3684c8a..33bf5adabe6 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -198,7 +198,9 @@ encryption is used." (mapcar #'car (epg-context-result-for context 'encrypted-to))) (if (or beg end) - (setq string (substring string (or beg 0) end))) + (setq string (substring string + (or beg 0) + (and end (min end (length string)))))) (save-excursion ;; If visiting, bind off buffer-file-name so that ;; file-locking will not ask whether we should diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 7e100569b0f..7eac1f89986 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -59,7 +59,7 @@ Otherwise, signal an error." ;;;###autoload (define-minor-mode epa-mail-mode "A minor-mode for composing encrypted/clearsigned mails." - nil " epa-mail" epa-mail-mode-map) + :lighter " epa-mail") ;;; Utilities diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 234b4b5a71d..219af3741fa 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -415,33 +415,33 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcase (intern (downcase (pcomplete-arg 1))) ('chat (mapcar (lambda (elt) (plist-get elt :nick)) (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'CHAT)) + (lambda (elt) + (eq (plist-get elt :type) 'CHAT)) erc-dcc-list))) ('close (delete-dups (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) erc-dcc-list))) ('get (mapcar #'erc-dcc-nick (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'GET)) + (lambda (elt) + (eq (plist-get elt :type) 'GET)) erc-dcc-list))) ('send (pcomplete-erc-all-nicks)))) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 2))) ('get (mapcar (lambda (elt) (plist-get elt :file)) (cl-remove-if-not - #'(lambda (elt) - (and (eq (plist-get elt :type) 'GET) - (erc-nick-equal-p (erc-extract-nick - (plist-get elt :nick)) - (pcomplete-arg 1)))) + (lambda (elt) + (and (eq (plist-get elt :type) 'GET) + (erc-nick-equal-p (erc-extract-nick + (plist-get elt :nick)) + (pcomplete-arg 1)))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) - (intern (upcase (pcomplete-arg 1))))) + (lambda (elt) + (eq (plist-get elt :type) + (intern (upcase (pcomplete-arg 1))))) erc-dcc-list))) ('send (pcomplete-entries))))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 0312d221ece..41256682c00 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -46,7 +46,6 @@ the mode if ARG is omitted or nil. ERC fill mode is a global minor mode. When enabled, messages in the channel buffers are filled." - nil nil nil :global t (if erc-fill-mode (erc-fill-enable) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 8be55558823..2364d45d6f3 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -464,9 +464,6 @@ ERC Track minor mode is a global minor mode. It exists for the sole purpose of providing the C-c C-SPC and C-c C-@ keybindings. Make sure that you have enabled the track module, otherwise the keybindings will not do anything useful." - :init-value nil - :lighter "" - :keymap erc-track-minor-mode-map :global t) (defun erc-track-minor-mode-maybe (&optional buffer) @@ -686,9 +683,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (let* ((buffers (mapcar #'car erc-modified-channels-alist)) (counts (mapcar #'cadr erc-modified-channels-alist)) (faces (mapcar #'cddr erc-modified-channels-alist)) - (long-names (mapcar #'(lambda (buf) - (or (buffer-name buf) - "")) + (long-names (mapcar (lambda (buf) + (or (buffer-name buf) + "")) buffers)) (short-names (if (functionp erc-track-shorten-function) (funcall erc-track-shorten-function diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2f6e48dce1a..e20aa8057de 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1289,7 +1289,6 @@ With a prefix argument ARG, enable %s if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. %s" name name doc) - nil nil nil ;; FIXME: We don't know if this group exists, so this `:group' may ;; actually just silence a valid warning about the fact that the var ;; is not associated with any group. @@ -2321,7 +2320,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." (use-local-map (make-sparse-keymap)) (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) (add-hook 'kill-buffer-hook - #'(lambda () (setq erc-debug-irc-protocol nil)) + (lambda () (setq erc-debug-irc-protocol nil)) nil 'local) (goto-char (point-max)) (let ((inhibit-read-only t)) @@ -2945,9 +2944,9 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (if (null (erc-with-server-buffer erc-ignore-list)) (erc-display-line (erc-make-notice "Ignore list is empty") 'active) (erc-display-line (erc-make-notice "Ignore list:") 'active) - (mapc #'(lambda (item) - (erc-display-line (erc-make-notice item) - 'active)) + (mapc (lambda (item) + (erc-display-line (erc-make-notice item) + 'active)) (erc-with-server-buffer erc-ignore-list)))) t) @@ -3129,8 +3128,8 @@ were most recently invited. See also `invitation'." (when chnl ;; Prevent double joining of same channel on same server. (let* ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) + (mapcar (lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) (erc-channel-list erc-server-process))) (server (with-current-buffer (process-buffer erc-server-process) (or erc-session-server erc-server-announced-name))) @@ -4149,9 +4148,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'." (mapconcat #'identity (let (res) - (mapc #'(lambda (x) - (if (stringp x) - (setq res (append res (list x))))) + (mapc (lambda (x) + (if (stringp x) + (setq res (append res (list x))))) parsed) res) " "))) @@ -4539,10 +4538,10 @@ See also: `erc-echo-notice-in-user-buffers', ;; Remove the unbanned masks from the ban list (setq erc-channel-banlist (cl-delete-if - #'(lambda (y) - (member (upcase (cdr y)) - (mapcar #'upcase - (cdr (split-string mode))))) + (lambda (y) + (member (upcase (cdr y)) + (mapcar #'upcase + (cdr (split-string mode))))) erc-channel-banlist))) ((string-match "^\\+" mode) ;; Add the banned mask(s) to the ban list diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 369382906c8..96c9a60deab 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -37,23 +37,19 @@ finish." (defcustom eshell-proc-load-hook nil "A hook that gets run when `eshell-proc' is loaded." :version "24.1" ; removed eshell-proc-initialize - :type 'hook - :group 'eshell-proc) + :type 'hook) (defcustom eshell-process-wait-seconds 0 "The number of seconds to delay waiting for a synchronous process." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-process-wait-milliseconds 50 "The number of milliseconds to delay waiting for a synchronous process." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-done-messages-in-minibuffer t "If non-nil, subjob \"Done\" messages will display in minibuffer." - :type 'boolean - :group 'eshell-proc) + :type 'boolean) (defcustom eshell-delete-exited-processes t "If nil, process entries will stick around until `jobs' is run. @@ -72,14 +68,12 @@ subjob is done is that it will no longer appear in the Note that Eshell will have to be restarted for a change in this variable's value to take effect." - :type 'boolean - :group 'eshell-proc) + :type 'boolean) (defcustom eshell-reset-signals "^\\(interrupt\\|killed\\|quit\\|stopped\\)" "If a termination signal matches this regexp, the terminal will be reset." - :type 'regexp - :group 'eshell-proc) + :type 'regexp) (defcustom eshell-exec-hook nil "Called each time a process is exec'd by `eshell-gather-process-output'. @@ -88,8 +82,7 @@ It is useful for things that must be done each time a process is executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag'). In contrast, `eshell-mode-hook' is only executed once, when the buffer is created." - :type 'hook - :group 'eshell-proc) + :type 'hook) (defcustom eshell-kill-hook nil "Called when a process run by `eshell-gather-process-output' has ended. @@ -99,8 +92,7 @@ nil, in which case the user attempted to send a signal, but there was no relevant process. This can be used for displaying help information, for example." :version "24.1" ; removed eshell-reset-after-proc - :type 'hook - :group 'eshell-proc) + :type 'hook) ;;; Internal Variables: @@ -126,8 +118,7 @@ information, for example." Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. - (if (memq #'eshell-reset-after-proc eshell-kill-hook) - (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook))) + (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) @@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by eshell-process-wait-milliseconds)))) (setq procs (cdr procs)))) -(defalias 'eshell/wait 'eshell-wait-for-process) +(defalias 'eshell/wait #'eshell-wait-for-process) (defun eshell/jobs (&rest _args) "List processes, if there are any." @@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC." (defcustom eshell-kill-process-wait-time 5 "Seconds to wait between sending termination signals to a subprocess." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) "Signals used to kill processes when an Eshell buffer exits. @@ -466,8 +456,7 @@ Eshell calls each of these signals in order when an Eshell buffer is killed; if the process is still alive afterwards, Eshell waits a number of seconds defined by `eshell-kill-process-wait-time', and tries the next signal in the list." - :type '(repeat symbol) - :group 'eshell-proc) + :type '(repeat symbol)) (defcustom eshell-kill-processes-on-exit nil "If non-nil, kill active processes when exiting an Eshell buffer. @@ -489,8 +478,7 @@ long to delay between signals." :type '(choice (const :tag "Kill all, don't ask" t) (const :tag "Ask before killing" ask) (const :tag "Ask for each process" every) - (const :tag "Don't kill subprocesses" nil)) - :group 'eshell-proc) + (const :tag "Don't kill subprocesses" nil))) (defun eshell-round-robin-kill (&optional query) "Kill current process by trying various signals in sequence. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index a48f62654d5..30104816f07 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'seq) (eval-when-compile (require 'cl-lib)) (defgroup eshell-util nil @@ -37,25 +38,21 @@ If nil, t will be represented only in the exit code of the function, and not printed as a string. This causes Lisp functions to behave similarly to external commands, as far as successful result output." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-group-file "/etc/group" "If non-nil, the name of the group file on your system." - :type '(choice (const :tag "No group file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No group file" nil) file)) (defcustom eshell-passwd-file "/etc/passwd" "If non-nil, the name of the passwd file on your system." - :type '(choice (const :tag "No passwd file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No passwd file" nil) file)) (defcustom eshell-hosts-file "/etc/hosts" "The name of the /etc/hosts file. Use `pcomplete-hosts-file' instead; this variable is obsolete and has no effect." - :type '(choice (const :tag "No hosts file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No hosts file" nil) file)) ;; Don't make it into an alias, because it doesn't really work with ;; custom and risks creating duplicate entries. Just point users to ;; the other variable, which is less frustrating. @@ -64,25 +61,21 @@ has no effect." (defcustom eshell-handle-errors t "If non-nil, Eshell will handle errors itself. Setting this to nil is offered as an aid to debugging only." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-private-file-modes 384 ; umask 177 "The file-modes value to use for creating \"private\" files." - :type 'integer - :group 'eshell-util) + :type 'integer) (defcustom eshell-private-directory-modes 448 ; umask 077 "The file-modes value to use for creating \"private\" directories." - :type 'integer - :group 'eshell-util) + :type 'integer) (defcustom eshell-tar-regexp "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" "Regular expression used to match tar file names." :version "24.1" ; added xz - :type 'regexp - :group 'eshell-util) + :type 'regexp) (defcustom eshell-convert-numeric-arguments t "If non-nil, converting arguments of numeric form to Lisp numbers. @@ -99,16 +92,14 @@ following in your init file: Any function with the property `eshell-no-numeric-conversions' set to a non-nil value, will be passed strings, not numbers, even when an argument matches `eshell-number-regexp'." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" "Regular expression used to match numeric arguments. If `eshell-convert-numeric-arguments' is non-nil, and an argument matches this regexp, it will be converted to a Lisp number, using the function `string-to-number'." - :type 'regexp - :group 'eshell-util) + :type 'regexp) (defcustom eshell-ange-ls-uids nil "List of user/host/id strings, used to determine remote ownership." @@ -116,8 +107,7 @@ function `string-to-number'." (string :tag "Hostname") (repeat (cons :tag "User/UID List" (string :tag "Username") - (repeat :tag "UIDs" string))))) - :group 'eshell-util) + (repeat :tag "UIDs" string)))))) ;;; Internal Variables: @@ -308,11 +298,11 @@ Prepend remote identification of `default-directory', if any." (defsubst eshell-stringify-list (args) "Convert each element of ARGS into a string value." - (mapcar 'eshell-stringify args)) + (mapcar #'eshell-stringify args)) (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat 'eshell-stringify (flatten-tree args) " ")) + (mapconcat #'eshell-stringify (flatten-tree args) " ")) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." @@ -471,7 +461,7 @@ list." (defsubst eshell-copy-environment () "Return an unrelated copy of `process-environment'." - (mapcar 'concat process-environment)) + (mapcar #'concat process-environment)) (defun eshell-subgroups (groupsym) "Return all of the subgroups of GROUPSYM." @@ -619,70 +609,68 @@ gid format. Valid values are `string' and `integer', defaulting to "If the `processp' function does not exist, PROC is not a process." (and (fboundp 'processp) (processp proc))) -; (defun eshell-copy-file -; (file newname &optional ok-if-already-exists keep-date) -; "Copy FILE to NEWNAME. See docs for `copy-file'." -; (let (copied) -; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) -; (let ((front (match-string 1 file)) -; (back (match-string 2 file)) -; buffer) -; (if (and front (string-match eshell-tar-regexp front) -; (setq buffer (find-file-noselect front))) -; (with-current-buffer buffer -; (goto-char (point-min)) -; (if (re-search-forward (concat " " (regexp-quote back) -; "$") nil t) -; (progn -; (tar-copy (if (file-directory-p newname) -; (expand-file-name -; (file-name-nondirectory back) newname) -; newname)) -; (setq copied t)) -; (error "%s not found in tar file %s" back front)))))) -; (unless copied -; (copy-file file newname ok-if-already-exists keep-date)))) - -; (defun eshell-file-attributes (filename) -; "Return a list of attributes of file FILENAME. -; See the documentation for `file-attributes'." -; (let (result) -; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) -; (let ((front (match-string 1 filename)) -; (back (match-string 2 filename)) -; buffer) -; (when (and front (string-match eshell-tar-regexp front) -; (setq buffer (find-file-noselect front))) -; (with-current-buffer buffer -; (goto-char (point-min)) -; (when (re-search-forward (concat " " (regexp-quote back) -; "\\s-*$") nil t) -; (let* ((descrip (tar-current-descriptor)) -; (tokens (tar-desc-tokens descrip))) -; (setq result -; (list -; (cond -; ((eq (tar-header-link-type tokens) 5) -; t) -; ((eq (tar-header-link-type tokens) t) -; (tar-header-link-name tokens))) -; 1 -; (tar-header-uid tokens) -; (tar-header-gid tokens) -; (tar-header-date tokens) -; (tar-header-date tokens) -; (tar-header-date tokens) -; (tar-header-size tokens) -; (concat -; (cond -; ((eq (tar-header-link-type tokens) 5) "d") -; ((eq (tar-header-link-type tokens) t) "l") -; (t "-")) -; (tar-grind-file-mode (tar-header-mode tokens) -; (make-string 9 ? ) 0)) -; nil nil nil)))))))) -; (or result -; (file-attributes filename)))) +;; (defun eshell-copy-file +;; (file newname &optional ok-if-already-exists keep-date) +;; "Copy FILE to NEWNAME. See docs for `copy-file'." +;; (let (copied) +;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) +;; (let ((front (match-string 1 file)) +;; (back (match-string 2 file)) +;; buffer) +;; (if (and front (string-match eshell-tar-regexp front) +;; (setq buffer (find-file-noselect front))) +;; (with-current-buffer buffer +;; (goto-char (point-min)) +;; (if (re-search-forward (concat " " (regexp-quote back) +;; "$") nil t) +;; (progn +;; (tar-copy (if (file-directory-p newname) +;; (expand-file-name +;; (file-name-nondirectory back) newname) +;; newname)) +;; (setq copied t)) +;; (error "%s not found in tar file %s" back front)))))) +;; (unless copied +;; (copy-file file newname ok-if-already-exists keep-date)))) + +;; (defun eshell-file-attributes (filename) +;; "Return a list of attributes of file FILENAME. +;; See the documentation for `file-attributes'." +;; (let (result) +;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) +;; (let ((front (match-string 1 filename)) +;; (back (match-string 2 filename)) +;; buffer) +;; (when (and front (string-match eshell-tar-regexp front) +;; (setq buffer (find-file-noselect front))) +;; (with-current-buffer buffer +;; (goto-char (point-min)) +;; (when (re-search-forward (concat " " (regexp-quote back) +;; "\\s-*$") nil t) +;; (let* ((descrip (tar-current-descriptor)) +;; (tokens (tar-desc-tokens descrip))) +;; (setq result +;; (list +;; (cond +;; ((eq (tar-header-link-type tokens) 5) +;; t) +;; ((eq (tar-header-link-type tokens) t) +;; (tar-header-link-name tokens))) +;; 1 +;; (tar-header-uid tokens) +;; (tar-header-gid tokens) +;; (tar-header-date tokens) +;; (tar-header-date tokens) +;; (tar-header-date tokens) +;; (tar-header-size tokens) +;; (file-modes-number-to-symbolic +;; (logior (tar-header-mode tokens) +;; (cond +;; ((eq (tar-header-link-type tokens) 5) 16384) +;; ((eq (tar-header-link-type tokens) t) 32768)))) +;; nil nil nil)))))))) +;; (or result +;; (file-attributes filename)))) ;; Obsolete. diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 2d06658b55c..8db1b42db44 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -539,6 +539,7 @@ filter out the color from the output." This is installed as a `revert-buffer-function' in the *Colors* buffer." (list-colors-display nil (buffer-name) list-colors-callback)) +;;;###autoload (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of diff --git a/lisp/files-x.el b/lisp/files-x.el index 23e4562f4b1..9e1954256a6 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -1,4 +1,4 @@ -;;; files-x.el --- extended file handling commands +;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).") "Normalize plist CRITERIA according to properties. Return a reordered plist." (apply - 'append + #'append (mapcar (lambda (property) (when (and (plist-member criteria property) (plist-get criteria property)) diff --git a/lisp/files.el b/lisp/files.el index b18d4bda764..ac508665c35 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7638,6 +7638,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." ;; Rights relative to the previous file modes. ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) ((= char ?u) (let ((uright (logand #o4700 from))) + ;; FIXME: These divisions/shifts seem to be right + ;; for the `7' part of the #o4700 mask, but not + ;; for the `4' part. Same below for `g' and `o'. (+ uright (/ uright #o10) (/ uright #o100)))) ((= char ?g) (let ((gright (logand #o2070 from))) (+ gright (/ gright #o10) (* gright #o10)))) @@ -7672,11 +7675,28 @@ as in \"og+rX-w\"." op char-right))) num-rights)) -(defun file-modes-number-to-symbolic (mode) +(defun file-modes-number-to-symbolic (mode &optional filetype) + "Return a string describing a a file's MODE. +For instance, if MODE is #o700, then it produces `-rwx------'. +FILETYPE if provided should be a character denoting the type of file, +such as `?d' for a directory, or `?l' for a symbolic link and will override +the leading `-' char." (string - (if (zerop (logand 8192 mode)) - (if (zerop (logand 16384 mode)) ?- ?d) - ?c) ; completeness + (or filetype + (pcase (lsh mode -12) + ;; POSIX specifies that the file type is included in st_mode + ;; and provides names for the file types but values only for + ;; the permissions (e.g., S_IWOTH=2). + + ;; (#o017 ??) ;; #define S_IFMT 00170000 + (#o014 ?s) ;; #define S_IFSOCK 0140000 + (#o012 ?l) ;; #define S_IFLNK 0120000 + ;; (8 ??) ;; #define S_IFREG 0100000 + (#o006 ?b) ;; #define S_IFBLK 0060000 + (#o004 ?d) ;; #define S_IFDIR 0040000 + (#o002 ?c) ;; #define S_IFCHR 0020000 + (#o001 ?p) ;; #define S_IFIFO 0010000 + (_ ?-))) (if (zerop (logand 256 mode)) ?- ?r) (if (zerop (logand 128 mode)) ?- ?w) (if (zerop (logand 64 mode)) diff --git a/lisp/find-file.el b/lisp/find-file.el index 8cc9c972ed4..6c3c0f123b1 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -1,4 +1,4 @@ -;;; find-file.el --- find a file corresponding to this one given a pattern +;;; find-file.el --- find a file corresponding to this one given a pattern -*- lexical-binding: t; -*- ;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au> ;; Maintainer: emacs-devel@gnu.org @@ -39,8 +39,8 @@ ;; and just has a different extension as described by the ff-other-file-alist ;; variable: ;; -;; '(("\\.cc$" (".hh" ".h")) -;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp"))) +;; '(("\\.cc\\'" (".hh" ".h")) +;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp"))) ;; ;; If the current file has a .cc extension, ff-find-other-file will attempt ;; to look for a .hh file, and then a .h file in some directory as described @@ -55,8 +55,8 @@ ;; format above can be changed to include a function to be called when the ;; current file matches the regexp: ;; -;; '(("\\.cc$" cc--function) -;; ("\\.hh$" hh-function)) +;; '(("\\.cc\\'" cc--function) +;; ("\\.hh\\'" hh-function)) ;; ;; These functions must return a list consisting of the possible names of the ;; corresponding file, with or without path. There is no real need for more @@ -64,10 +64,10 @@ ;; file-alist: ;; ;; (setq cc-other-file-alist -;; '(("\\.cc$" ff-cc-hh-converter) -;; ("\\.hh$" ff-cc-hh-converter) -;; ("\\.c$" (".h")) -;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) +;; '(("\\.cc\\'" ff-cc-hh-converter) +;; ("\\.hh\\'" ff-cc-hh-converter) +;; ("\\.c\\'" (".h")) +;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) ;; ;; ff-cc-hh-converter is included at the end of this file as a reference. ;; @@ -130,62 +130,51 @@ (defcustom ff-pre-find-hook nil "List of functions to be called before the search for the file starts." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-pre-load-hook nil "List of functions to be called before the other file is loaded." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-post-load-hook nil "List of functions to be called after the other file is loaded." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-not-found-hook nil "List of functions to be called if the other file could not be found." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-file-created-hook nil "List of functions to be called if the other file needs to be created." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-case-fold-search nil "Non-nil means ignore cases in matches (see `case-fold-search'). If you have extensions in different cases, you will want this to be nil." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-always-in-other-window nil "If non-nil, find the corresponding file in another window by default. To override this, give an argument to `ff-find-other-file'." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-ignore-include nil "If non-nil, ignore `#include' lines." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-always-try-to-create t "If non-nil, always attempt to create the other file if it was not found." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-quiet-mode nil "If non-nil, trace which directories are being searched." - :type 'boolean - :group 'ff) + :type 'boolean) ;;;###autoload (defcustom ff-special-constructs ;; C/C++ include, for NeXTstep too `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") . - (lambda () - (buffer-substring (match-beginning 2) (match-end 2))))) + ,(lambda () (match-string 2)))) ;; We include `ff-treat-as-special' documentation here so that autoload ;; can make it available to be read prior to loading this file. "List of special constructs recognized by `ff-treat-as-special'. @@ -194,8 +183,7 @@ If REGEXP matches the current line (from the beginning of the line), `ff-treat-as-special' calls function EXTRACT with no args. If EXTRACT returns nil, keep trying. Otherwise, return the filename that EXTRACT returned." - :type '(repeat (cons regexp function)) - :group 'ff) + :type '(repeat (cons regexp function))) (defvaralias 'ff-related-file-alist 'ff-other-file-alist) (defcustom ff-other-file-alist 'cc-other-file-alist @@ -207,8 +195,7 @@ directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). This alist should be set by the major mode." :type '(choice (repeat (list regexp (choice (repeat string) function))) - symbol) - :group 'ff) + symbol)) (defcustom ff-search-directories 'cc-search-directories "List of directories to search for a specific file. @@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string. The stars are *not* wildcards: they are searched for together with the preceding slash. The star represents all the subdirectories except `..', and each of these subdirectories will be searched in turn." - :type '(choice (repeat directory) symbol) - :group 'ff) + :type '(choice (repeat directory) symbol)) (defcustom cc-search-directories '("." "/usr/include" "/usr/local/include/*") "See the description of the `ff-search-directories' variable." - :type '(repeat directory) - :group 'ff) + :type '(repeat directory)) (defcustom cc-other-file-alist '(("\\.cc\\'" (".hh" ".h")) @@ -269,17 +254,15 @@ since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh')." :version "24.4" ; add .m - :type '(repeat (list regexp (choice (repeat string) function))) - :group 'ff) + :type '(repeat (list regexp (choice (repeat string) function)))) (defcustom modula2-other-file-alist '( - ("\\.mi$" (".md")) ;; Modula-2 module definition - ("\\.md$" (".mi")) ;; and implementation. + ("\\.mi\\'" (".md")) ;; Modula-2 module definition + ("\\.md\\'" (".mi")) ;; and implementation. ) "See the description for the `ff-search-directories' variable." - :type '(repeat (list regexp (choice (repeat string) function))) - :group 'ff) + :type '(repeat (list regexp (choice (repeat string) function)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -308,16 +291,14 @@ See also the documentation for `ff-find-other-file'. If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (interactive "P") - (let ((ignore ff-ignore-include)) - (setq ff-ignore-include t) - (ff-find-the-other-file in-other-window) - (setq ff-ignore-include ignore))) + (let ((ff-ignore-include t)) + (ff-find-the-other-file in-other-window))) ;;;###autoload -(defalias 'ff-find-related-file 'ff-find-other-file) +(defalias 'ff-find-related-file #'ff-find-other-file) ;;;###autoload -(defun ff-find-other-file (&optional in-other-window ignore-include) +(defun ff-find-other-file (&optional in-other-window ignore-include event) "Find the header or source file corresponding to this file. Being on a `#include' line pulls in that file. @@ -369,11 +350,11 @@ Variables of interest include: - `ff-file-created-hook' List of functions to be called if the other file has been created." - (interactive "P") - (let ((ignore ff-ignore-include)) - (setq ff-ignore-include ignore-include) - (ff-find-the-other-file in-other-window) - (setq ff-ignore-include ignore))) + (interactive (list current-prefix-arg nil last-nonmenu-event)) + (save-excursion + (posn-set-point (event-end event)) + (let ((ff-ignore-include ignore-include)) + (ff-find-the-other-file in-other-window)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support functions @@ -413,9 +394,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (message "Working...") (setq dirs - (if (symbolp ff-search-directories) - (ff-list-replace-env-vars (symbol-value ff-search-directories)) - (ff-list-replace-env-vars ff-search-directories))) + (ff-list-replace-env-vars (if (symbolp ff-search-directories) + (symbol-value ff-search-directories) + ff-search-directories))) (setq fname (ff-treat-as-special)) @@ -454,11 +435,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." ;; if we have a function to generate new names, ;; invoke it with the name of the current file (if (and (atom action) (fboundp action)) - (progn - (setq suffixes (funcall action (ff-buffer-file-name)) - match (cons (car match) (list suffixes)) - stub nil - default-name (car suffixes))) + (setq suffixes (funcall action (ff-buffer-file-name)) + match (cons (car match) (list suffixes)) + stub nil + default-name (car suffixes)) ;; otherwise build our filename stub (cond @@ -472,7 +452,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (t (setq format (concat "\\(.+\\)" (car match))) (string-match format fname) - (setq stub (substring fname (match-beginning 1) (match-end 1))) + ;; FIXME: What if `string-match' failed? + (setq stub (match-string 1 fname)) )) ;; if we find nothing, we should try to get a file like this one @@ -522,89 +503,6 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." found)) ;; return buffer-name or filename -(defun ff-other-file-name () - "Return name of the header or source file corresponding to the current file. -Being on a `#include' line pulls in that file, but see the help on -the `ff-ignore-include' variable." - - (let (match ;; matching regexp for this file - suffixes ;; set of replacing regexps for the matching regexp - action ;; function to generate the names of the other files - fname ;; basename of this file - pos ;; where we start matching filenames - stub ;; name of the file without extension - alist ;; working copy of the list of file extensions - pathname ;; the pathname of the file or the #include line - format ;; what we have to match - found ;; name of the file or buffer found - nil if none - dirs) ;; local value of ff-search-directories - - (message "Working...") - - (setq dirs - (if (symbolp ff-search-directories) - (ff-list-replace-env-vars (symbol-value ff-search-directories)) - (ff-list-replace-env-vars ff-search-directories))) - - (setq fname (ff-treat-as-special)) - - (cond - ((and (not ff-ignore-include) fname) - (setq found (ff-get-file-name dirs fname nil))) - - ;; let's just get the corresponding file - (t - (setq alist (if (symbolp ff-other-file-alist) - (symbol-value ff-other-file-alist) - ff-other-file-alist) - pathname (or (ff-buffer-file-name) "/none.none")) - - (setq fname (file-name-nondirectory pathname) - match (car alist)) - - ;; find the table entry corresponding to this file - (setq pos (ff-string-match (car match) fname)) - (while (and match (if (and pos (>= pos 0)) nil (not pos))) - (setq alist (cdr alist)) - (setq match (car alist)) - (setq pos (ff-string-match (car match) fname))) - - ;; no point going on if we haven't found anything - (when match - - ;; otherwise, suffixes contains what we need - (setq suffixes (car (cdr match)) - action (car (cdr match)) - found nil) - - ;; if we have a function to generate new names, - ;; invoke it with the name of the current file - (if (and (atom action) (fboundp action)) - (progn - (setq suffixes (funcall action (ff-buffer-file-name)) - match (cons (car match) (list suffixes)) - stub nil)) - - ;; otherwise build our filename stub - (cond - - ;; get around the problem that 0 and nil both mean false! - ((= pos 0) - (setq format "") - (setq stub "") - ) - - (t - (setq format (concat "\\(.+\\)" (car match))) - (string-match format fname) - (setq stub (substring fname (match-beginning 1) (match-end 1))) - ))) - - ;; do the real work - find the file - (setq found - (ff-get-file-name dirs stub suffixes))))) - found)) ;; return buffer-name or filename - (defun ff-get-file (search-dirs filename &optional suffix-list other-window) "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search @@ -709,11 +607,10 @@ name of the first file found." ;; otherwise dir matches the '/*', so search each dir separately (progn - (if (match-beginning 2) - (setq rest (substring dir (match-beginning 2) (match-end 2))) - (setq rest "") - ) - (setq dir (substring dir (match-beginning 1) (match-end 1))) + (setq rest (if (match-beginning 2) + (match-string 2 dir) + "")) + (setq dir (match-string 1 dir)) (let ((dirlist (ff-all-dirs-under dir '(".."))) this-dir compl-dirs) @@ -743,8 +640,8 @@ name of the first file found." (defun ff-string-match (regexp string &optional start) "Like `string-match', but set `case-fold-search' temporarily. The value used comes from `ff-case-fold-search'." - (let ((case-fold-search ff-case-fold-search)) - (if regexp + (if regexp + (let ((case-fold-search ff-case-fold-search)) (string-match regexp string start)))) (defun ff-list-replace-env-vars (search-list) @@ -752,12 +649,12 @@ The value used comes from `ff-case-fold-search'." (let (list (var (car search-list))) (while search-list - (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var) + (if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var) (setq var (concat - (substring var (match-beginning 1) (match-end 1)) - (getenv (substring var (match-beginning 2) (match-end 2))) - (substring var (match-beginning 3) (match-end 3))))) + (match-string 1 var) + (getenv (match-string 2 var)) + (match-string 3 var)))) (setq search-list (cdr search-list)) (setq list (cons var list)) (setq var (car search-list))) @@ -782,11 +679,7 @@ See variable `ff-special-constructs'." (setq match (cdr elem))) fname))) -(defun ff-basename (string) - "Return the basename of pathname STRING." - (setq string (concat "/" string)) - (string-match ".*/\\([^/]+\\)$" string) - (setq string (substring string (match-beginning 1) (match-end 1)))) +(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1") (defun ff-all-dirs-under (here &optional exclude) "Get all the directory files under directory HERE. @@ -800,7 +693,7 @@ Exclude all files in the optional EXCLUDE list." (setq file (car files)) (if (and (file-directory-p file) - (not (member (ff-basename file) exclude))) + (not (member (file-name-nondirectory file) exclude))) (setq dirlist (cons file dirlist))) (setq files (cdr files))) (setq dirlist (reverse dirlist)))) @@ -820,84 +713,65 @@ or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs. If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is called before `ff-post-load-hook'." (run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks) - (if (or - (and in-other-window (not ff-always-in-other-window)) - (and (not in-other-window) ff-always-in-other-window)) - (funcall f2 file) - (funcall f1 file)) + (funcall (if (or + (and in-other-window (not ff-always-in-other-window)) + (and (not in-other-window) ff-always-in-other-window)) + f2 f1) + file) (if new-file (run-hooks 'ff-file-created-hook 'ff-file-created-hooks)) (run-hooks 'ff-post-load-hook 'ff-post-load-hooks)) (defun ff-find-file (file &optional in-other-window new-file) "Like `find-file', but may show the file in another window." - (ff-switch-file 'find-file - 'find-file-other-window + (ff-switch-file #'find-file + #'find-file-other-window file in-other-window new-file)) (defun ff-switch-to-buffer (buffer-or-name &optional in-other-window) "Like `switch-to-buffer', but may show the buffer in another window." - (ff-switch-file 'switch-to-buffer - 'switch-to-buffer-other-window + (ff-switch-file #'switch-to-buffer + #'switch-to-buffer-other-window buffer-or-name in-other-window nil)) ;;;###autoload -(defun ff-mouse-find-other-file (event) - "Visit the file you click on." - (interactive "e") - (save-excursion - (mouse-set-point event) - (ff-find-other-file nil))) +(define-obsolete-function-alias + 'ff-mouse-find-other-file #'ff-find-other-file "28.1") ;;;###autoload -(defun ff-mouse-find-other-file-other-window (event) - "Visit the file you click on in another window." - (interactive "e") - (save-excursion - (mouse-set-point event) - (ff-find-other-file t))) +(define-obsolete-function-alias + 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1") +;;;###autoload +(defun ff-find-other-file-other-window (event) + "Visit the file you point at in another window." + (interactive (list last-nonmenu-event)) + (ff-find-other-file t nil event)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This section offers an example of user defined function to select files -(defun ff-upcase-p (string &optional start end) - "Return t if STRING is all uppercase. -Given START and/or END, checks between these characters." - (let (match str) - (if (not start) - (setq start 0)) - (if (not end) - (setq end (length string))) - (if (= start end) - (setq end (1+ end))) - (setq str (substring string start end)) - (if (and - (ff-string-match "[A-Z]+" str) - (setq match (match-data)) - (= (car match) 0) - (= (car (cdr match)) (length str))) - t - nil))) +(defun ff-upcase-p (string) + "Return t if STRING is all uppercase." + ;; FIXME: Why `ff-string-match' since `[:upper:]' only makes + ;; sense when `case-fold-search' is nil? + (ff-string-match "\\`[[:upper:]]*\\'" string)) (defun ff-cc-hh-converter (arg) "Discriminate file extensions. Build up a new file list based possibly on part of the directory name and the name of the file passed in." (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg) - (let ((dire (if (match-beginning 2) - (substring arg (match-beginning 2) (match-end 2)) nil)) - (file (if (match-beginning 3) - (substring arg (match-beginning 3) (match-end 3)) nil)) - (extn (if (match-beginning 4) - (substring arg (match-beginning 4) (match-end 4)) nil)) + (let ((dire (match-string 2 arg)) + (file (match-string 3 arg)) + (extn (match-string 4 arg)) return-list) (cond ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h} ((and (string= extn "cc") - (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file)) - (let ((stub (substring file (match-beginning 2) (match-end 2)))) - (setq dire (upcase (substring file (match-beginning 1) (match-end 1)))) + (ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file)) + (let ((stub (match-string 2 file))) + (setq dire (upcase (match-string 1 file))) (setq return-list (list (concat stub ".hh") (concat stub ".h") (concat file ".hh") diff --git a/lisp/foldout.el b/lisp/foldout.el index 3419d7f5981..cadf2746ba1 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -1,4 +1,4 @@ -;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode +;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- lexical-binding: t -*- ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. @@ -33,7 +33,7 @@ ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) ;; to expose the body or C-c C-i to expose the child (level-2) headings. ;; -;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body +;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body ;; and child subheadings and narrows the buffer so that only the level-1 ;; heading, the body and the level-2 headings are visible. If you now want to ;; look under one of the level-2 headings, position the cursor on it and do C-c @@ -57,7 +57,7 @@ ;; zoomed-in heading. This is useful for restricting changes to a particular ;; chapter or section of your document. ;; -;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides +;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides ;; all the text and subheadings under the top-level heading and returns you to ;; the previous view of the buffer. Specifying a numeric argument exits that ;; many folds. Specifying a zero argument exits *all* folds. @@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).") (defvar-local foldout-mode-line-string nil "Mode line string announcing that we are in an outline fold.") +;; FIXME: This should be rewritten as a proper minor mode. + ;; put our minor mode string immediately following outline-minor-mode's (or (assq 'foldout-mode-line-string minor-mode-alist) (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) @@ -227,8 +229,7 @@ An end marker of nil means the fold ends after (point-max).") (error "Can't find outline-minor-mode in minor-mode-alist")) ;; slip our fold announcement into the list - (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) - )) + (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))))) @@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:- ((> exposure-value 0) (outline-show-children exposure-value)) (t - (outline-show-subtree)) - ) + (outline-show-subtree))) ;; save the location of the fold we are entering (setq foldout-fold-list (cons (cons start-marker end-marker) foldout-fold-list)) ;; update the mode line - (foldout-update-mode-line) - ))) + (foldout-update-mode-line)))) (defun foldout-exit-fold (&optional num-folds) @@ -308,8 +307,7 @@ exited and text is left visible." ;; have we been told not to hide the fold? ((< num-folds 0) (setq hide-fold nil - num-folds (- num-folds))) - ) + num-folds (- num-folds)))) ;; limit the number of folds if we've been told to exit too many (setq num-folds (min num-folds (length foldout-fold-list))) @@ -482,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one." event) (defun foldout-mouse-goto-heading (event) - "Go to the heading where the mouse event started. Signal an error -if the event didn't occur on a heading." + "Go to the heading where the mouse EVENT started. +Signal an error if the event didn't occur on a heading." (goto-char (posn-point (event-start event))) (or (outline-on-heading-p) ;; outline.el sometimes treats beginning-of-buffer as a heading @@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}. Valid modifiers are shift, control, meta, alt, hyper and super.") -(if foldout-inhibit-key-bindings - () - (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) - (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) +(unless foldout-inhibit-key-bindings + (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree) + (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold) (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) (unless map (setq map (make-sparse-keymap)) (define-key outline-minor-mode-map outline-minor-mode-prefix map)) - (define-key map "\C-z" 'foldout-zoom-subtree) - (define-key map "\C-x" 'foldout-exit-fold)) - (let* ((modifiers (apply 'concat + (define-key map "\C-z" #'foldout-zoom-subtree) + (define-key map "\C-x" #'foldout-exit-fold)) + (let* ((modifiers (apply #'concat (mapcar (lambda (modifier) (vector (cond @@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") ((eq modifier 'alt) ?A) ((eq modifier 'hyper) ?H) ((eq modifier 'super) ?s) - (t (error "invalid mouse modifier %s" + (t (error "Invalid mouse modifier %s" modifier))) ?-)) foldout-mouse-modifiers))) @@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) - (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) + (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit) - (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) - )) + (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit))) ;; Obsolete. diff --git a/lisp/font-core.el b/lisp/font-core.el index 4b695424977..db06a607660 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -126,7 +126,6 @@ buffer local value for `font-lock-defaults', via its mode hook. The above is the default behavior of `font-lock-mode'; you may specify your own function which is called when `font-lock-mode' is toggled via `font-lock-function'." - nil nil nil :after-hook (font-lock-initial-fontify) ;; Don't turn on Font Lock mode if we don't have a display (we're running a ;; batch job) or if the buffer is invisible (the name starts with a space). diff --git a/lisp/frame.el b/lisp/frame.el index 2b6e4a60b83..bca160175a5 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -301,7 +301,7 @@ This function runs the abnormal hook `move-frame-functions'." (declare-function tool-bar-mode "tool-bar" (&optional arg)) (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) -(defalias 'tool-bar-lines-needed 'tool-bar-height) +(defalias 'tool-bar-lines-needed #'tool-bar-height) ;; startup.el calls this function after loading the user's init ;; file. Now default-frame-alist and initial-frame-alist contain @@ -690,8 +690,8 @@ is not considered (see `next-frame')." 0)) (select-frame-set-input-focus (selected-frame))) -(defalias 'next-multiframe-window 'next-window-any-frame) -(defalias 'previous-multiframe-window 'previous-window-any-frame) +(defalias 'next-multiframe-window #'next-window-any-frame) +(defalias 'previous-multiframe-window #'previous-window-any-frame) (defun window-system-for-display (display) "Return the window system for DISPLAY. @@ -782,7 +782,7 @@ If DISPLAY is nil, that stands for the selected frame's display." (format "Delete %s frames? " (length frames)) (format "Delete %s ? " (car frames)))))) (error "Abort!") - (mapc 'delete-frame frames) + (mapc #'delete-frame frames) (x-close-connection display)))) (defun make-frame-command () @@ -1162,8 +1162,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." :group 'faces :set #'(lambda (var value) (set-default var value) - (mapc 'frame-set-background-mode (frame-list))) - :initialize 'custom-initialize-changed + (mapc #'frame-set-background-mode (frame-list))) + :initialize #'custom-initialize-changed :type '(choice (const dark) (const light) (const :tag "automatic" nil))) @@ -1176,6 +1176,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." (defvar inhibit-frame-set-background-mode nil) +(defun frame--current-backround-mode (frame) + (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) + (bg-color (frame-parameter frame 'background-color)) + (tty-type (tty-type frame)) + (default-bg-mode + (if (or (window-system frame) + (and tty-type + (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" + tty-type))) + 'light + 'dark))) + (cond (frame-default-bg-mode) + ((equal bg-color "unspecified-fg") ; inverted colors + (if (eq default-bg-mode 'light) 'dark 'light)) + ((not (color-values bg-color frame)) + default-bg-mode) + ((color-dark-p (mapcar (lambda (c) (/ c 65535.0)) + (color-values bg-color frame))) + 'dark) + (t 'light)))) + (defun frame-set-background-mode (frame &optional keep-face-specs) "Set up display-dependent faces on FRAME. Display-dependent faces are those which have different definitions @@ -1184,30 +1205,8 @@ according to the `background-mode' and `display-type' frame parameters. If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate face specs for the new background mode." (unless inhibit-frame-set-background-mode - (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) - (bg-color (frame-parameter frame 'background-color)) - (tty-type (tty-type frame)) - (default-bg-mode - (if (or (window-system frame) - (and tty-type - (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" - tty-type))) - 'light - 'dark)) - (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light)) - (bg-mode - (cond (frame-default-bg-mode) - ((equal bg-color "unspecified-fg") ; inverted colors - non-default-bg-mode) - ((not (color-values bg-color frame)) - default-bg-mode) - ((>= (apply '+ (color-values bg-color frame)) - ;; Just looking at the screen, colors whose - ;; values add up to .6 of the white total - ;; still look dark to me. - (* (apply '+ (color-values "white" frame)) .6)) - 'light) - (t 'dark))) + (let* ((bg-mode + (frame--current-backround-mode frame)) (display-type (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) @@ -1273,6 +1272,26 @@ the `background-mode' terminal parameter." (intern (downcase bg-resource)))) (terminal-parameter frame 'background-mode))) +;; FIXME: This needs to be significantly improved before we can use it: +;; - Fix the "scope" to be consistent: the code below is partly per-frame +;; and partly all-frames :-( +;; - Make it interact correctly with color themes (e.g. modus-themes). +;; Maybe automatically disabling color themes that disagree with the +;; selected value of `dark-mode'. +;; - Check interaction with "(in|re)verse-video". +;; +;; (define-minor-mode dark-mode +;; "Use light text on dark background." +;; :global t +;; :group 'faces +;; (when (eq dark-mode +;; (eq 'light (frame--current-backround-mode (selected-frame)))) +;; ;; FIXME: Change the face's SPEC instead? +;; (set-face-attribute 'default nil +;; :foreground (face-attribute 'default :background) +;; :background (face-attribute 'default :foreground)) +;; (frame-set-background-mode (selected-frame)))) + ;;;; Frame configurations @@ -1357,9 +1376,9 @@ differing font heights." If FRAME is omitted, describe the currently selected frame." (cdr (assq 'width (frame-parameters frame)))) -(defalias 'frame-border-width 'frame-internal-border-width) -(defalias 'frame-pixel-width 'frame-native-width) -(defalias 'frame-pixel-height 'frame-native-height) +(defalias 'frame-border-width #'frame-internal-border-width) +(defalias 'frame-pixel-width #'frame-native-width) +(defalias 'frame-pixel-height #'frame-native-height) (defun frame-inner-width (&optional frame) "Return inner width of FRAME in pixels. @@ -1991,9 +2010,9 @@ frame's display)." (fboundp 'image-mask-p) (fboundp 'image-size))) -(defalias 'display-blink-cursor-p 'display-graphic-p) -(defalias 'display-multi-frame-p 'display-graphic-p) -(defalias 'display-multi-font-p 'display-graphic-p) +(defalias 'display-blink-cursor-p #'display-graphic-p) +(defalias 'display-multi-frame-p #'display-graphic-p) +(defalias 'display-multi-font-p #'display-graphic-p) (defun display-selections-p (&optional display) "Return non-nil if DISPLAY supports selections. @@ -2340,13 +2359,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to the opposite frame edge from the edge indicated in the input spec." (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame))) -(defun delete-other-frames (&optional frame) +(defun delete-other-frames (&optional frame iconify) "Delete all frames on FRAME's terminal, except FRAME. If FRAME uses another frame's minibuffer, the minibuffer frame is left untouched. Do not delete any of FRAME's child frames. If FRAME is a child frame, delete its siblings only. FRAME must be -a live frame and defaults to the selected one." - (interactive) +a live frame and defaults to the selected one. +If the prefix arg ICONIFY is non-nil, just iconify the frames rather than +deleting them." + (interactive "i\nP") (setq frame (window-normalize-frame frame)) (let ((minibuffer-frame (window-frame (minibuffer-window frame))) (this (next-frame frame t)) @@ -2361,7 +2382,7 @@ a live frame and defaults to the selected one." (and parent (not (eq (frame-parent this) parent))) ;; Do not delete a child frame of FRAME. (eq (frame-parent this) frame)) - (delete-frame this)) + (if iconify (iconify-frame this) (delete-frame this))) (setq this next)) ;; In a second round consider all remaining frames. (setq this (next-frame frame t)) @@ -2373,7 +2394,7 @@ a live frame and defaults to the selected one." (and parent (not (eq (frame-parent this) parent))) ;; Do not delete a child frame of FRAME. (eq (frame-parent this) frame)) - (delete-frame this)) + (if iconify (iconify-frame this) (delete-frame this))) (setq this next)))) @@ -2399,7 +2420,7 @@ parameters `bottom-divider-width' and `right-divider-width'." :type '(choice (const :tag "Bottom only" bottom-only) (const :tag "Right only" right-only) (const :tag "Bottom and right" t)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2420,7 +2441,7 @@ parameter `bottom-divider-width'." :type '(restricted-sexp :tag "Default width of bottom dividers" :match-alternatives (window-divider-width-valid-p)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2437,7 +2458,7 @@ parameter `right-divider-width'." :type '(restricted-sexp :tag "Default width of right dividers" :match-alternatives (window-divider-width-valid-p)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2714,14 +2735,14 @@ See also `toggle-frame-maximized'." ;;;; Key bindings -(define-key ctl-x-5-map "2" 'make-frame-command) -(define-key ctl-x-5-map "1" 'delete-other-frames) -(define-key ctl-x-5-map "0" 'delete-frame) -(define-key ctl-x-5-map "o" 'other-frame) -(define-key ctl-x-5-map "5" 'other-frame-prefix) -(define-key global-map [f11] 'toggle-frame-fullscreen) -(define-key global-map [(meta f10)] 'toggle-frame-maximized) -(define-key esc-map [f10] 'toggle-frame-maximized) +(define-key ctl-x-5-map "2" #'make-frame-command) +(define-key ctl-x-5-map "1" #'delete-other-frames) +(define-key ctl-x-5-map "0" #'delete-frame) +(define-key ctl-x-5-map "o" #'other-frame) +(define-key ctl-x-5-map "5" #'other-frame-prefix) +(define-key global-map [f11] #'toggle-frame-fullscreen) +(define-key global-map [(meta f10)] #'toggle-frame-maximized) +(define-key esc-map [f10] #'toggle-frame-maximized) ;; Misc. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 0f4e1ae4a6e..4505d8513f9 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -32,6 +32,17 @@ ;; ;; (require 'generic-x) ;; +;; You can decide which modes to load by setting the variable +;; `generic-extras-enable-list'. Its default value is platform- +;; specific. The recommended way to set this variable is through +;; customize: +;; +;; M-x customize-option RET generic-extras-enable-list RET +;; +;; This lets you select generic modes from the list of available +;; modes. If you manually set `generic-extras-enable-list' in your +;; .emacs, do it BEFORE loading generic-x with (require 'generic-x). +;; ;; You can also send in new modes; if the file types are reasonably ;; common, we would like to install them. ;; @@ -173,7 +184,88 @@ This hook will be installed if the variable ;; Other Generic modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; If you add a generic mode to this file, put it in one of these four +;; lists as well. + +(defconst generic-default-modes + '(apache-conf-generic-mode + apache-log-generic-mode + hosts-generic-mode + java-manifest-generic-mode + java-properties-generic-mode + javascript-generic-mode + show-tabs-generic-mode + vrml-generic-mode) + "List of generic modes that are defined by default.") + +(defconst generic-mswindows-modes + '(bat-generic-mode + inf-generic-mode + ini-generic-mode + rc-generic-mode + reg-generic-mode + rul-generic-mode) + "List of generic modes that are defined by default on MS-Windows.") + +(defconst generic-unix-modes + '(alias-generic-mode + ansible-inventory-generic-mode + etc-fstab-generic-mode + etc-modules-conf-generic-mode + etc-passwd-generic-mode + etc-services-generic-mode + etc-sudoers-generic-mode + fvwm-generic-mode + inetd-conf-generic-mode + mailagent-rules-generic-mode + mailrc-generic-mode + named-boot-generic-mode + named-database-generic-mode + prototype-generic-mode + resolve-conf-generic-mode + samba-generic-mode + x-resource-generic-mode + xmodmap-generic-mode) + "List of generic modes that are defined by default on Unix.") + +(defconst generic-other-modes + '(astap-generic-mode + ibis-generic-mode + pkginfo-generic-mode + spice-generic-mode) + "List of generic modes that are not defined by default.") + +(defcustom generic-extras-enable-list + (append generic-default-modes + (if (memq system-type '(windows-nt ms-dos)) + generic-mswindows-modes + generic-unix-modes) + nil) + "List of generic modes to define. +Each entry in the list should be a symbol. If you set this variable +directly, without using customize, you must reload generic-x to put +your changes into effect." + :type (let (list) + (dolist (mode + (sort (append generic-default-modes + generic-mswindows-modes + generic-unix-modes + generic-other-modes + nil) + (lambda (a b) + (string< (symbol-name b) + (symbol-name a)))) + (cons 'set list)) + (push `(const ,mode) list))) + :set (lambda (s v) + (set-default s v) + (unless load-in-progress + (load "generic-x"))) + :version "22.1") + ;;; Apache +(when (memq 'apache-conf-generic-mode generic-extras-enable-list) + (define-generic-mode apache-conf-generic-mode '(?#) nil @@ -186,7 +278,9 @@ This hook will be installed if the variable '((nil "^\\([-A-Za-z0-9_]+\\)" 1) ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))) - "Generic mode for Apache or HTTPD configuration files.") + "Generic mode for Apache or HTTPD configuration files.")) + +(when (memq 'apache-log-generic-mode generic-extras-enable-list) (define-generic-mode apache-log-generic-mode nil @@ -197,9 +291,11 @@ This hook will be installed if the variable (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Generic mode for Apache log files.") + "Generic mode for Apache log files.")) ;;; Samba +(when (memq 'samba-generic-mode generic-extras-enable-list) + (define-generic-mode samba-generic-mode '(?\; ?#) nil @@ -209,11 +305,13 @@ This hook will be installed if the variable (2 font-lock-type-face))) '("smb\\.conf\\'") '(generic-bracket-support) - "Generic mode for Samba configuration files.") + "Generic mode for Samba configuration files.")) ;;; Fvwm ;; This is pretty basic. Also, modes for other window managers could ;; be defined as well. +(when (memq 'fvwm-generic-mode generic-extras-enable-list) + (define-generic-mode fvwm-generic-mode '(?#) '("AddToMenu" @@ -232,28 +330,33 @@ This hook will be installed if the variable nil '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") nil - "Generic mode for FVWM configuration files.") + "Generic mode for FVWM configuration files.")) ;;; X Resource ;; I'm pretty sure I've seen an actual mode to do this, but I don't ;; think it's standard with Emacs +(when (memq 'x-resource-generic-mode generic-extras-enable-list) + (define-generic-mode x-resource-generic-mode '(?!) nil '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") nil - "Generic mode for X Resource configuration files.") + "Generic mode for X Resource configuration files.")) +(if (memq 'xmodmap-generic-mode generic-extras-enable-list) (define-generic-mode xmodmap-generic-mode '(?!) '("add" "clear" "keycode" "keysym" "remove" "pointer") nil '("[xX]modmap\\(rc\\)?\\'") nil - "Simple mode for xmodmap files.") + "Simple mode for xmodmap files.")) ;;; Hosts +(when (memq 'hosts-generic-mode generic-extras-enable-list) + (define-generic-mode hosts-generic-mode '(?#) '("localhost") @@ -261,20 +364,27 @@ This hook will be installed if the variable ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face)) '("[hH][oO][sS][tT][sS]\\'") nil - "Generic mode for HOSTS files.") + "Generic mode for HOSTS files.")) ;;; Windows INF files +;; If i-g-m-f-f-h is defined, then so is i-g-m. +(declare-function ini-generic-mode "generic-x") + +(when (memq 'inf-generic-mode generic-extras-enable-list) + (define-generic-mode inf-generic-mode '(?\;) nil '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) '("\\.[iI][nN][fF]\\'") '(generic-bracket-support) - "Generic mode for MS-Windows INF files.") + "Generic mode for MS-Windows INF files.")) ;;; Windows INI files ;; Should define escape character as well! +(when (memq 'ini-generic-mode generic-extras-enable-list) + (define-generic-mode ini-generic-mode '(?\;) nil @@ -301,9 +411,13 @@ like an INI file. You can add this hook to `find-file-hook'." (goto-char (point-min)) (and (looking-at "^\\s-*\\[.*\\]") (ini-generic-mode))))) +(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook + 'ini-generic-mode-find-file-hook "28.1")) ;;; Windows REG files ;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! +(when (memq 'reg-generic-mode generic-extras-enable-list) + (define-generic-mode reg-generic-mode '(?\;) '("key" "classes_root" "REGEDIT" "REGEDIT4") @@ -314,11 +428,19 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) - "Generic mode for MS-Windows Registry files.") + "Generic mode for MS-Windows Registry files.")) + +(declare-function w32-shell-name "w32-fns" ()) + +;;; DOS/Windows BAT files +(when (memq 'bat-generic-mode generic-extras-enable-list) + (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4")) ;;; Mailagent ;; Mailagent is a Unix mail filtering program. Anyone wanna do a ;; generic mode for procmail? +(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list) + (define-generic-mode mailagent-rules-generic-mode '(?#) '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT") @@ -329,9 +451,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) - "Generic mode for Mailagent rules files.") + "Generic mode for Mailagent rules files.")) ;; Solaris/Sys V prototype files +(when (memq 'prototype-generic-mode generic-extras-enable-list) + (define-generic-mode prototype-generic-mode '(?#) nil @@ -350,9 +474,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("prototype\\'") nil - "Generic mode for Sys V prototype files.") + "Generic mode for Sys V prototype files.")) ;; Solaris/Sys V pkginfo files +(when (memq 'pkginfo-generic-mode generic-extras-enable-list) + (define-generic-mode pkginfo-generic-mode '(?#) nil @@ -361,9 +487,17 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("pkginfo\\'") nil - "Generic mode for Sys V pkginfo files.") + "Generic mode for Sys V pkginfo files.")) + +;; Javascript mode +;; Obsolete; defer to js-mode from js.el. +(when (memq 'javascript-generic-mode generic-extras-enable-list) + (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") + (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) ;; VRML files +(when (memq 'vrml-generic-mode generic-extras-enable-list) + (define-generic-mode vrml-generic-mode '(?#) '("DEF" @@ -411,9 +545,11 @@ like an INI file. You can add this hook to `find-file-hook'." ("*Definitions*" "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 1))))) - "Generic Mode for VRML files.") + "Generic Mode for VRML files.")) ;; Java Manifests +(when (memq 'java-manifest-generic-mode generic-extras-enable-list) + (define-generic-mode java-manifest-generic-mode '(?#) '("Name" @@ -430,9 +566,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Generic mode for Java Manifest files.") + "Generic mode for Java Manifest files.")) ;; Java properties files +(when (memq 'java-properties-generic-mode generic-extras-enable-list) + (define-generic-mode java-properties-generic-mode '(?! ?#) nil @@ -458,9 +596,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) - "Generic mode for Java properties files.") + "Generic mode for Java properties files.")) ;; C shell alias definitions +(when (memq 'alias-generic-mode generic-extras-enable-list) + (define-generic-mode alias-generic-mode '(?#) '("alias" "unalias") @@ -473,9 +613,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) - "Generic mode for C Shell alias files.") + "Generic mode for C Shell alias files.")) ;; Ansible inventory files +(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list) + (define-generic-mode ansible-inventory-generic-mode '(?#) nil @@ -494,10 +636,12 @@ like an INI file. You can add this hook to `find-file-hook'." (setq imenu-generic-expression '((nil "^\\s-*\\[\\(.*\\)\\]" 1) ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) - "Generic mode for Ansible inventory files.") + "Generic mode for Ansible inventory files.")) ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) +(when (memq 'rc-generic-mode generic-extras-enable-list) + (define-generic-mode rc-generic-mode ;; '(?\/) '("//") @@ -577,13 +721,15 @@ like an INI file. You can add this hook to `find-file-hook'." '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))) - '("\\.[rR][cC]\\'") - nil - "Generic mode for MS-Windows Resource files.") + '("\\.[rR][cC]\\'") + nil + "Generic mode for MS-Windows Resource files.")) ;; InstallShield RUL files ;; Contributed by Alfred.Correira@Pervasive.Com ;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com> +(when (memq 'rul-generic-mode generic-extras-enable-list) + (eval-when-compile ;;; build the regexp strings using regexp-opt @@ -1226,9 +1372,11 @@ like an INI file. You can add this hook to `find-file-hook'." > "begin" \n > _ \n resume: - > "end;") + > "end;")) ;; Additions by ACorreir@pervasive-sw.com (Alfred Correira) +(when (memq 'mailrc-generic-mode generic-extras-enable-list) + (define-generic-mode mailrc-generic-mode '(?#) '("alias" @@ -1250,9 +1398,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("\\.mailrc\\'") nil - "Mode for mailrc files.") + "Mode for mailrc files.")) ;; Inetd.conf +(when (memq 'inetd-conf-generic-mode generic-extras-enable-list) + (define-generic-mode inetd-conf-generic-mode '(?#) '("stream" @@ -1267,9 +1417,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) ;; Services +(when (memq 'etc-services-generic-mode generic-extras-enable-list) + (define-generic-mode etc-services-generic-mode '(?#) '("tcp" @@ -1282,9 +1434,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) ;; Password and Group files +(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) + (define-generic-mode etc-passwd-generic-mode nil ;; No comment characters '("root") ;; Only one keyword @@ -1322,9 +1476,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))) ;; Fstab +(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) + (define-generic-mode etc-fstab-generic-mode '(?#) '("adfs" @@ -1436,9 +1592,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([^# \t]+\\)\\s-+" 1)))))) + '((nil "^\\([^# \t]+\\)\\s-+" 1))))))) ;; /etc/sudoers +(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) + (define-generic-mode etc-sudoers-generic-mode '(?#) '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias" @@ -1449,9 +1607,11 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face)) '("/etc/sudoers\\'") nil - "Generic mode for sudoers configuration files.") + "Generic mode for sudoers configuration files.")) ;; From Jacques Duthen <jacques.duthen@sncf.fr> +(when (memq 'show-tabs-generic-mode generic-extras-enable-list) + (eval-when-compile (defconst show-tabs-generic-mode-font-lock-defaults-1 @@ -1489,12 +1649,14 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces.") + "Generic mode to show tabs and trailing spaces.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(when (memq 'named-boot-generic-mode generic-extras-enable-list) + (define-generic-mode named-boot-generic-mode ;; List of comment characters '(?\;) @@ -1510,7 +1672,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/named\\.boot\\'") ;; List of set up functions to call - nil) + nil)) + +(when (memq 'named-database-generic-mode generic-extras-enable-list) (define-generic-mode named-database-generic-mode ;; List of comment characters @@ -1531,7 +1695,9 @@ like an INI file. You can add this hook to `find-file-hook'." (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string))) + (insert (format-time-string named-database-time-string)))) + +(when (memq 'resolve-conf-generic-mode generic-extras-enable-list) (define-generic-mode resolve-conf-generic-mode ;; List of comment characters @@ -1543,12 +1709,14 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional auto-mode-alist expressions '("/etc/resolve?\\.conf\\'") ;; List of set up functions to call - nil) + nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes for spice and common electrical engineering circuit netlist formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(when (memq 'spice-generic-mode generic-extras-enable-list) + (define-generic-mode spice-generic-mode nil '("and" @@ -1584,7 +1752,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for SPICE circuit netlist files.") + "Generic mode for SPICE circuit netlist files.")) + +(when (memq 'ibis-generic-mode generic-extras-enable-list) (define-generic-mode ibis-generic-mode '(?|) @@ -1593,7 +1763,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) '("\\.[iI][bB][sS]\\'") '(generic-bracket-support) - "Generic mode for IBIS circuit netlist files.") + "Generic mode for IBIS circuit netlist files.")) + +(when (memq 'astap-generic-mode generic-extras-enable-list) (define-generic-mode astap-generic-mode nil @@ -1627,7 +1799,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for ASTAP circuit netlist files.") + "Generic mode for ASTAP circuit netlist files.")) + +(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) (define-generic-mode etc-modules-conf-generic-mode ;; List of comment characters @@ -1669,98 +1843,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/modules\\.conf" "/etc/conf\\.modules") ;; List of set up functions to call - nil) - -;; Obsolete - -(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3") -(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3") - -(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4") - -(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook - #'ini-generic-mode-find-file-hook "28.1") - -(defconst generic-default-modes - '(apache-conf-generic-mode - apache-log-generic-mode - hosts-generic-mode - java-manifest-generic-mode - java-properties-generic-mode - javascript-generic-mode - show-tabs-generic-mode - vrml-generic-mode) - "List of generic modes that are defined by default.") -(make-obsolete-variable 'generic-default-modes "no longer used." "28.1") - -(defconst generic-mswindows-modes - '(bat-generic-mode - inf-generic-mode - ini-generic-mode - rc-generic-mode - reg-generic-mode - rul-generic-mode) - "List of generic modes that are defined by default on MS-Windows.") -(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1") - -(defconst generic-unix-modes - '(alias-generic-mode - ansible-inventory-generic-mode - etc-fstab-generic-mode - etc-modules-conf-generic-mode - etc-passwd-generic-mode - etc-services-generic-mode - etc-sudoers-generic-mode - fvwm-generic-mode - inetd-conf-generic-mode - mailagent-rules-generic-mode - mailrc-generic-mode - named-boot-generic-mode - named-database-generic-mode - prototype-generic-mode - resolve-conf-generic-mode - samba-generic-mode - x-resource-generic-mode - xmodmap-generic-mode) - "List of generic modes that are defined by default on Unix.") -(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1") - -(defconst generic-other-modes - '(astap-generic-mode - ibis-generic-mode - pkginfo-generic-mode - spice-generic-mode) - "List of generic modes that are not defined by default.") -(make-obsolete-variable 'generic-other-modes "no longer used." "28.1") - -(defcustom generic-extras-enable-list - (append generic-default-modes - (if (memq system-type '(windows-nt ms-dos)) - generic-mswindows-modes - generic-unix-modes) - nil) - "List of generic modes to define. -Each entry in the list should be a symbol. If you set this variable -directly, without using customize, you must reload generic-x to put -your changes into effect." - :type (let (list) - (dolist (mode - (sort (append generic-default-modes - generic-mswindows-modes - generic-unix-modes - generic-other-modes - nil) - (lambda (a b) - (string< (symbol-name b) - (symbol-name a)))) - (cons 'set list)) - (push `(const ,mode) list))) - :set (lambda (s v) - (set-default s v) - (unless load-in-progress - (load "generic-x"))) - :version "22.1") -(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1") + nil)) (provide 'generic-x) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 4249b50b9ff..34947cece89 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1134,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise." (define-minor-mode gnus-message-citation-mode "Minor mode providing more font-lock support for nested citations. When enabled, it automatically turns on `font-lock-mode'." - nil ;; init-value - "" ;; lighter - nil ;; keymap + :lighter "" (when (derived-mode-p 'message-mode) ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car font-lock-defaults)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fad4ef3dcf6..f3b830cf849 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -120,12 +120,13 @@ :group 'message-buffers :type 'integer) -(defcustom message-send-rename-function nil +(defcustom message-send-rename-function #'message-default-send-rename-function "Function called to rename the buffer after sending it." :group 'message-buffers - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-fcc-handler-function 'message-output +(defcustom message-fcc-handler-function #'message-output "A function called to save outgoing articles. This function will be called with the name of the file to store the article in. The default function is `message-output' which saves in Unix @@ -418,7 +419,7 @@ you can explicitly override this setting by calling :type 'string :group 'message-various) -(defcustom message-cross-post-note-function 'message-cross-post-insert-note +(defcustom message-cross-post-note-function #'message-cross-post-insert-note "Function to use to insert note about Crosspost or Followup-To. The function will be called with four arguments. The function should not only insert a note, but also ensure old notes are deleted. See the documentation @@ -756,7 +757,7 @@ See also `send-mail-function'." :link '(custom-manual "(message)Mail Variables") :group 'message-mail) -(defcustom message-send-news-function 'message-send-news +(defcustom message-send-news-function #'message-send-news "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." @@ -765,29 +766,32 @@ variable `mail-header-separator'." :link '(custom-manual "(message)News Variables") :type 'function) -(defcustom message-reply-to-function nil +(defcustom message-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-wide-reply-to-function nil +(defcustom message-wide-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Wide Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-followup-to-function nil +(defcustom message-followup-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Followup") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) (defcustom message-extra-wide-headers nil "If non-nil, a list of additional address headers. @@ -1021,7 +1025,7 @@ the signature is inserted." :version "22.1" :group 'message-various) -(defcustom message-citation-line-function 'message-insert-citation-line +(defcustom message-citation-line-function #'message-insert-citation-line "Function called to insert the \"Whomever writes:\" line. Predefined functions include `message-insert-citation-line' and @@ -1103,7 +1107,7 @@ Used by `message-yank-original' via `message-yank-cite'." :link '(custom-manual "(message)Insertion Variables") :type 'integer) -(defcustom message-cite-function 'message-cite-original-without-signature +(defcustom message-cite-function #'message-cite-original-without-signature "Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. @@ -1116,7 +1120,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil." :version "22.3" ;; Gnus 5.10.12 (changed default) :group 'message-insertion) -(defcustom message-indent-citation-function 'message-indent-citation +(defcustom message-indent-citation-function #'message-indent-citation "Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave @@ -2847,79 +2851,79 @@ Consider adding this function to `message-header-setup-hook'" (unless message-mode-map (setq message-mode-map (make-keymap)) (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" 'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) + (define-key message-mode-map "\C-c?" #'describe-mode) + + (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) + (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) + (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) + (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) + (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) + (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) + (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) + (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) + (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) + (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) + (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) (define-key message-mode-map "\C-c\C-f\C-i" - 'message-insert-or-toggle-importance) + #'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\C-f\C-a" - 'message-generate-unsubscribed-mail-followup-to) + #'message-generate-unsubscribed-mail-followup-to) ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" 'message-change-subject) + (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) ;; - (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) + (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) + (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) + (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) + (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) + (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - (define-key message-mode-map "\C-c\C-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) + (define-key message-mode-map "\C-c\C-b" #'message-goto-body) + (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires) + (define-key message-mode-map "\C-c\C-t" #'message-insert-to) + (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) + (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) + (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) + (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\M-n" - 'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" 'message-send) - (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" 'message-dont-send) - (define-key message-mode-map "\C-c\n" 'gnus-delay-article) - - (define-key message-mode-map "\C-c\M-k" 'message-kill-address) - (define-key message-mode-map "\C-c\C-e" 'message-elide-region) - (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) - (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - (define-key message-mode-map [remap split-line] 'message-split-line) - - (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) - (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot) - - (define-key message-mode-map "\C-a" 'message-beginning-of-line) - (define-key message-mode-map "\t" 'message-tab) - - (define-key message-mode-map "\M-n" 'message-display-abbrev)) + #'message-insert-disposition-notification-to) + + (define-key message-mode-map "\C-c\C-y" #'message-yank-original) + (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) + (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) + (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) + (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) + (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) + (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) + (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) + + (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) + (define-key message-mode-map "\C-c\C-s" #'message-send) + (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) + (define-key message-mode-map "\C-c\C-d" #'message-dont-send) + (define-key message-mode-map "\C-c\n" #'gnus-delay-article) + + (define-key message-mode-map "\C-c\M-k" #'message-kill-address) + (define-key message-mode-map "\C-c\C-e" #'message-elide-region) + (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) + (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) + (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) + (define-key message-mode-map [remap split-line] #'message-split-line) + + (define-key message-mode-map "\C-c\C-a" #'mml-attach-file) + (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot) + + (define-key message-mode-map "\C-a" #'message-beginning-of-line) + (define-key message-mode-map "\t" #'message-tab) + + (define-key message-mode-map "\M-n" #'message-display-abbrev)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -3169,14 +3173,13 @@ Like `text-mode', but with these additional commands: ;; `electric-pair-mode', and C-M-* navigation by syntactically ;; excluding citations and other artifacts. ;; - (setq-local syntax-propertize-function 'message--syntax-propertize) + (setq-local syntax-propertize-function #'message--syntax-propertize) (setq-local parse-sexp-ignore-comments t) (setq-local message-encoded-mail-cache nil)) (defun message-setup-fill-variables () "Setup message fill variables." (setq-local fill-paragraph-function #'message-fill-paragraph) - (make-local-variable 'adaptive-fill-first-line-regexp) (let ((quote-prefix-regexp ;; User should change message-cite-prefix-regexp if ;; message-yank-prefix is set to an abnormal value. @@ -3287,7 +3290,7 @@ Like `text-mode', but with these additional commands: (push-mark) (message-position-on-field "Summary" "Subject")) -(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") +(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1") (defun message-goto-body (&optional interactive) "Move point to the beginning of the message body. Returns point." @@ -6662,9 +6665,8 @@ moved to the beginning " (not (buffer-modified-p buffer))) (kill-buffer buffer)))) ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (message-default-send-rename-function)) + (funcall (or message-send-rename-function + #'message-default-send-rename-function)) ;; Push the current buffer onto the list. (when message-max-buffers (setq message-buffer-list @@ -6763,8 +6765,9 @@ are not included." (defun message-setup-1 (headers &optional yank-action actions return-action) (dolist (action actions) (condition-case nil + ;; FIXME: Use functions rather than expressions! (add-to-list 'message-send-actions - `(apply ',(car action) ',(cdr action))))) + `(apply #',(car action) ',(cdr action))))) (setq message-return-action return-action) (setq message-reply-buffer (if (and (consp yank-action) @@ -6903,7 +6906,7 @@ are not included." ;;;###autoload (defun message-mail (&optional to subject other-headers continue switch-function yank-action send-actions - return-action &rest ignored) + return-action &rest _) "Start editing a mail message to be sent. OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION @@ -7127,15 +7130,12 @@ want to get rid of this query permanently."))) ;; specific, and just Cc-in the rest. (setq follow-to (list (cons 'To - (mapconcat - (lambda (addr) - (cdr addr)) recipients ", ")))) + (mapconcat #'cdr recipients ", ")))) ;; Put the first recipient in the To header. (setq follow-to (list (cons 'To (cdr (pop recipients))))) ;; Put the rest of the recipients in Cc. (when recipients - (setq recipients (mapconcat - (lambda (addr) (cdr addr)) recipients ", ")) + (setq recipients (mapconcat #'cdr recipients ", ")) (if (string-match "^ +" recipients) (setq recipients (substring recipients (match-end 0)))) (push (cons 'Cc recipients) follow-to))))) @@ -7862,7 +7862,7 @@ is for the internal use." (interactive) (setq rmail-enable-mime-composing t) (setq rmail-insert-mime-forwarded-message-function - 'message-forward-rmail-make-body)) + #'message-forward-rmail-make-body)) ;;;###autoload (defun message-resend (address) diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 56ca2e14b6f..76a7e21567a 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,4 +1,3 @@ - ;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 4d020232939..cbb69b206d4 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -1,4 +1,4 @@ -;;; hippie-exp.el --- expand text trying various ways to find its expansion +;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*- ;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc. @@ -58,7 +58,7 @@ ;; The variable `hippie-expand-dabbrev-as-symbol' controls whether ;; characters of syntax '_' is considered part of the words to expand ;; dynamically. -;; See also the macro `make-hippie-expand-function' below. +;; See also the function `make-hippie-expand-function' below. ;; ;; A short description of the current try-functions in this file: ;; `try-complete-file-name' : very convenient to have in any buffer, @@ -215,50 +215,42 @@ "The list of expansion functions tried in order by `hippie-expand'. To change the behavior of `hippie-expand', remove, change the order of, or insert functions in this list." - :type '(repeat function) - :group 'hippie-expand) + :type '(repeat function)) (defcustom hippie-expand-verbose t "Non-nil makes `hippie-expand' output which function it is trying." - :type 'boolean - :group 'hippie-expand) + :type 'boolean) (defcustom hippie-expand-dabbrev-skip-space nil "Non-nil means tolerate trailing spaces in the abbreviation to expand." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-dabbrev-as-symbol t "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-no-restriction t "Non-nil means that narrowed buffers are widened during search." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-max-buffers () "The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched." :type '(choice (const :tag "All" nil) - integer) - :group 'hippie-expand) + integer)) (defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)." - :type '(repeat (choice regexp (symbol :tag "Major Mode"))) - :group 'hippie-expand) + :type '(repeat (choice regexp (symbol :tag "Major Mode")))) (defcustom hippie-expand-only-buffers () "A list specifying the only buffers to search (in addition to current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms). If non-nil, this variable overrides the variable `hippie-expand-ignore-buffers'." - :type '(repeat (choice regexp (symbol :tag "Major Mode"))) - :group 'hippie-expand) + :type '(repeat (choice regexp (symbol :tag "Major Mode")))) ;;;###autoload (defun hippie-expand (arg) @@ -407,18 +399,19 @@ undoes the expansion." ;; try-expand-line-all-buffers))) ;; ;;;###autoload -(defmacro make-hippie-expand-function (try-list &optional verbose) +(defun make-hippie-expand-function (try-list &optional verbose) "Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose." - `(lambda (arg) - ,(concat - "Try to expand text before point, using the following functions: \n" - (mapconcat 'prin1-to-string (eval try-list) ", ")) - (interactive "P") - (let ((hippie-expand-try-functions-list ,try-list) - (hippie-expand-verbose ,verbose)) - (hippie-expand arg)))) + (lambda (arg) + (:documentation + (concat + "Try to expand text before point, using the following functions: \n" + (mapconcat #'prin1-to-string try-list ", "))) + (interactive "P") + (let ((hippie-expand-try-functions-list try-list) + (hippie-expand-verbose verbose)) + (hippie-expand arg)))) ;;; Here follows the try-functions and their requisites: @@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil otherwise." (he-init-string (he-file-name-beg) (point)) (let ((name-part (file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (file-name-directory - he-search-string) "")))) + he-search-string) + "")))) (if (not (he-string-member name-part he-tried-table)) (setq he-tried-table (cons name-part he-tried-table))) (if (and (not (equal he-search-string "")) @@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil otherwise." (setq he-expand-list (sort (file-name-all-completions name-part dir-part) - 'string-lessp)) + #'string-lessp)) (setq he-expand-list ()))))) (while (and he-expand-list @@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil otherwise." (or (boundp sym) (fboundp sym) (symbol-plist sym)))) - 'string-lessp))))) + #'string-lessp))))) (while (and he-expand-list (he-string-member (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list))) @@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil otherwise." (setq he-expand-list (and (not (equal he-search-string "")) (mapcar (lambda (sym) - (if (and (boundp sym) (vectorp (eval sym))) + (if (and (boundp sym) + (abbrev-table-p (symbol-value sym))) (abbrev-expansion (downcase he-search-string) - (eval sym)))) + (symbol-value sym)))) (append '(local-abbrev-table global-abbrev-table) abbrev-table-name-list)))))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 44574abd46a..1dc8acbe1f3 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -402,7 +402,7 @@ format. See `ibuffer-update-saved-filters-format' and ;;;###autoload (define-minor-mode ibuffer-auto-mode "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)." - nil nil nil + :lighter nil (unless (derived-mode-p 'ibuffer-mode) (error "This buffer is not in Ibuffer mode")) (cond (ibuffer-auto-mode @@ -687,8 +687,8 @@ specifications with the same structure as `ibuffer-filtering-qualifiers'." (not (memq nil ;; a filter will return nil if it failed - (mapcar #'(lambda (filter) - (ibuffer-included-in-filter-p buf filter)) + (mapcar (lambda (filter) + (ibuffer-included-in-filter-p buf filter)) filters)))) (defun ibuffer-unary-operand (filter) @@ -724,8 +724,8 @@ specification, with the same structure as an element of the list ;; (dolist (filter-spec (cdr filter) nil) ;; (when (ibuffer-included-in-filter-p buf filter-spec) ;; (throw 'has-match t)))) - (memq t (mapcar #'(lambda (x) - (ibuffer-included-in-filter-p buf x)) + (memq t (mapcar (lambda (x) + (ibuffer-included-in-filter-p buf x)) (cdr filter)))) ('and (catch 'no-match @@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'." (message "No buffers marked; use `m' to mark a buffer") (let ((count (ibuffer-map-marked-lines - #'(lambda (_buf _mark) - 'kill)))) + (lambda (_buf _mark) + 'kill)))) (message "Killed %s lines" count)))) ;;;###autoload @@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable." (when current-prefix-arg (setq only-visible (not only-visible))) (if only-visible - (let ((table (mapcar #'(lambda (x) - (buffer-name (car x))) + (let ((table (mapcar (lambda (x) + (buffer-name (car x))) (ibuffer-current-state-list)))) (when (null table) (error "No buffers!")) @@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that variable." (let (buf-point) ;; Blindly search for our buffer: it is very likely that it is ;; not in a hidden filter group. - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t nil) (when (and (null buf-point) @@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that variable." (dolist (group ibuffer-hidden-filter-groups) (ibuffer-jump-to-filter-group group) (ibuffer-toggle-filter-group) - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t group) (if buf-point (throw 'found nil) @@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands with \\[yank]." (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) (let ((count (ibuffer-map-lines - #'(lambda (buf _mark) - (when (funcall func buf) - (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark - ibuffer-marked-char)) - t)) + (lambda (buf _mark) + (when (funcall func buf) + (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark + ibuffer-marked-char)) + t)) nil group))) (ibuffer-redisplay t) @@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with \\[yank]." "Mark all buffers whose name matches REGEXP." (interactive "sMark by name (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (string-match regexp (buffer-name buf))))) + (lambda (buf) + (string-match regexp (buffer-name buf))))) (defun ibuffer-locked-buffer-p (&optional buf) "Return non-nil if BUF is locked. @@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line." "Mark all buffers whose major mode matches REGEXP." (interactive "sMark by major mode (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (string-match regexp (format-mode-line mode-name nil nil buf)))))) + (lambda (buf) + (with-current-buffer buf + (string-match regexp (format-mode-line mode-name nil nil buf)))))) ;;;###autoload (defun ibuffer-mark-by-file-name-regexp (regexp) @@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of (interactive (let ((reg (read-string "Mark by content (regexp): "))) (list reg current-prefix-arg))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (let ((mode (with-current-buffer buf major-mode)) - res) - (cond ((and (not all-buffers) - (or - (memq mode ibuffer-never-search-content-mode) - (cl-dolist (x ibuffer-never-search-content-name nil) - (when-let ((found (string-match x (buffer-name buf)))) - (cl-return found))))) - (setq res nil)) - (t - (with-current-buffer buf - (save-mark-and-excursion - (goto-char (point-min)) - (setq res (re-search-forward regexp nil t)))))) res)))) + (lambda (buf) + (let ((mode (with-current-buffer buf major-mode)) + res) + (cond ((and (not all-buffers) + (or + (memq mode ibuffer-never-search-content-mode) + (cl-dolist (x ibuffer-never-search-content-name nil) + (when-let ((found (string-match x (buffer-name buf)))) + (cl-return found))))) + (setq res nil)) + (t + (with-current-buffer buf + (save-mark-and-excursion + (goto-char (point-min)) + (setq res (re-search-forward regexp nil t)))))) res)))) ;;;###autoload (defun ibuffer-mark-by-mode (mode) @@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of (format-prompt "Mark by major mode" default) (ibuffer-list-buffer-modes) nil t nil nil default))))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (eq (buffer-local-value 'major-mode buf) mode)))) + (lambda (buf) + (eq (buffer-local-value 'major-mode buf) mode)))) ;;;###autoload (defun ibuffer-mark-modified-buffers () "Mark all modified buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-modified-p buf)))) + (lambda (buf) (buffer-modified-p buf)))) ;;;###autoload (defun ibuffer-mark-unsaved-buffers () "Mark all modified buffers that have an associated file." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf) - (buffer-modified-p buf))))) + (lambda (buf) (and (buffer-local-value 'buffer-file-name buf) + (buffer-modified-p buf))))) ;;;###autoload (defun ibuffer-mark-dissociated-buffers () "Mark all buffers whose associated file does not exist." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (or - (and buffer-file-name - (not (file-exists-p buffer-file-name))) - (and (eq major-mode 'dired-mode) - (boundp 'dired-directory) - (stringp dired-directory) - (not (file-exists-p (file-name-directory dired-directory))))))))) + (lambda (buf) + (with-current-buffer buf + (or + (and buffer-file-name + (not (file-exists-p buffer-file-name))) + (and (eq major-mode 'dired-mode) + (boundp 'dired-directory) + (stringp dired-directory) + (not (file-exists-p (file-name-directory dired-directory))))))))) ;;;###autoload (defun ibuffer-mark-help-buffers () "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (memq major-mode ibuffer-help-buffer-modes))))) + (lambda (buf) + (with-current-buffer buf + (memq major-mode ibuffer-help-buffer-modes))))) ;;;###autoload (defun ibuffer-mark-compressed-file-buffers () "Mark buffers whose associated file is compressed." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (and buffer-file-name - (string-match ibuffer-compressed-file-name-regexp - buffer-file-name)))))) + (lambda (buf) + (with-current-buffer buf + (and buffer-file-name + (string-match ibuffer-compressed-file-name-regexp + buffer-file-name)))))) ;;;###autoload (defun ibuffer-mark-old-buffers () "Mark buffers which have not been viewed in `ibuffer-old-time' hours." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (when buffer-display-time - (time-less-p - (* 60 60 ibuffer-old-time) - (time-since buffer-display-time))))))) + (lambda (buf) + (with-current-buffer buf + (when buffer-display-time + (time-less-p + (* 60 60 ibuffer-old-time) + (time-since buffer-display-time))))))) ;;;###autoload (defun ibuffer-mark-special-buffers () "Mark all buffers whose name begins and ends with `*'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (string-match "^\\*.+\\*$" - (buffer-name buf))))) + (lambda (buf) (string-match "^\\*.+\\*$" + (buffer-name buf))))) ;;;###autoload (defun ibuffer-mark-read-only-buffers () "Mark all read-only buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-local-value 'buffer-read-only buf)))) + (lambda (buf) (buffer-local-value 'buffer-read-only buf)))) ;;;###autoload (defun ibuffer-mark-dired-buffers () "Mark all `dired' buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) + (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) ;;;###autoload (defun ibuffer-do-occur (regexp &optional nlines) @@ -1970,8 +1970,8 @@ defaults to one." (let ((ibuffer-do-occur-bufs nil)) ;; Accumulate a list of marked buffers (ibuffer-map-marked-lines - #'(lambda (buf _mark) - (push buf ibuffer-do-occur-bufs))) + (lambda (buf _mark) + (push buf ibuffer-do-occur-bufs))) (occur-1 regexp nlines ibuffer-do-occur-bufs))) (provide 'ibuf-ext) diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index be09c6582ce..fcc4f9e751c 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST." (ibuffer-redisplay-engine ;; Get rid of dead buffers (delq nil - (mapcar #'(lambda (e) (when (buffer-live-p (car e)) - e)) + (mapcar (lambda (e) (when (buffer-live-p (car e)) + e)) ibuffer-save-marks-tmp-mark-list))) (ibuffer-redisplay t)))))) @@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'. (ibuffer-redisplay t) (setq ibuffer-last-sorting-mode ',name)) (push (list ',name ,description - #'(lambda (a b) - ,@body)) + (lambda (a b) + ,@body)) ibuffer-sorting-functions-alist) :autoload-end)) @@ -259,18 +259,18 @@ buffer object. 'ibuffer-map-deletion-lines) (_ 'ibuffer-map-marked-lines)) - #'(lambda (buf mark) - ;; Silence warning for code that doesn't - ;; use `mark'. - (ignore mark) - ,(if (eq modifier-p :maybe) - `(let ((ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (prog1 ,inner-body - (when (not (eq ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (setq ibuffer-did-modification t)))) - inner-body))))) + (lambda (buf mark) + ;; Silence warning for code that doesn't + ;; use `mark'. + (ignore mark) + ,(if (eq modifier-p :maybe) + `(let ((ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (prog1 ,inner-body + (when (not (eq ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (setq ibuffer-did-modification t)))) + inner-body))))) ,finish))) (if dangerous `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index da589c00649..d5b6f76d7b2 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'." (completion--cache-all-sorted-completions beg end (cons comp all)))) finally return all))) +(defvar icomplete-vertical-mode-minibuffer-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-n") 'icomplete-forward-completions) + (define-key map (kbd "C-p") 'icomplete-backward-completions) + map) + "Keymap used by `icomplete-vertical-mode' in the minibuffer.") + +(defun icomplete--vertical-minibuffer-setup () + "Setup the minibuffer for vertical display of completion candidates." + (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map + (current-local-map))) + (setq-local icomplete-separator "\n" + icomplete-hide-common-prefix nil + ;; Ask `icomplete-completions' to return enough completions candidates. + icomplete-prospects-height 25 + redisplay-adhoc-scroll-in-resize-mini-windows nil)) + +;;;###autoload +(define-minor-mode icomplete-vertical-mode + "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'. + +As many completion candidates as possible are displayed, depending on +the value of `max-mini-window-height', and the way the mini-window is +resized depends on `resize-mini-windows'." + :global t + (remove-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup) + (when icomplete-vertical-mode + (add-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup))) + @@ -784,10 +815,13 @@ matches exist." (if last (setcdr last base-size)) (if prospects (concat determ - "{" - (mapconcat 'identity prospects icomplete-separator) - (and limit (concat icomplete-separator ellipsis)) - "}") + (if icomplete-vertical-mode " \n" "{") + (mapconcat 'identity prospects (if icomplete-vertical-mode + "\n" + icomplete-separator)) + (unless icomplete-vertical-mode + (concat (and limit (concat icomplete-separator ellipsis)) + "}"))) (concat determ " [Matched]")))))) ;;; Iswitchb compatibility diff --git a/lisp/image-mode.el b/lisp/image-mode.el index f4ff35f9c41..69ef7015cce 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -713,8 +713,7 @@ Key bindings: Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], to switch back to `image-mode' and display an image file as the actual image." - nil (:eval (if image-type (format " Image[%s]" image-type) " Image")) - image-minor-mode-map + :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image")) :group 'image :version "22.1" (if image-minor-mode diff --git a/lisp/informat.el b/lisp/informat.el index 3da23516333..bac09752b70 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -1,4 +1,4 @@ -;;; informat.el --- info support functions package for Emacs +;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc. @@ -140,7 +140,7 @@ (or (bolp) (newline)) (insert "\^_\f\nTag table:\n") - (if (eq major-mode 'info-mode) + (if (derived-mode-p 'info-mode) (move-marker Info-tag-table-marker (point))) (setq tag-list (nreverse tag-list)) (while tag-list diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 3be7849df19..793508cae4a 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -323,11 +323,9 @@ (insert ")\n\n"))) (defun skkdic-convert (filename &optional dirname) - "Generate Emacs Lisp file form Japanese dictionary file FILENAME. + "Generate Emacs Lisp file from Japanese dictionary file FILENAME. The format of the dictionary file should be the same as SKK dictionaries. -Optional argument DIRNAME if specified is the directory name under which -the generated Emacs Lisp is saved. -The name of generated file is specified by the variable `ja-dic-filename'." +Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)." (interactive "FSKK dictionary file: ") (let* ((skkbuf (get-buffer-create " *skkdic-unannotated*")) (buf (get-buffer-create "*skkdic-work*"))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 943e24aa563..5efac4c78f4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -172,6 +172,29 @@ This allows you to resume earlier Isearch sessions through the command history." :type 'boolean) +(defcustom isearch-wrap-pause t + "Define the behavior of wrapping when there are no more matches. +When `t' (by default), signal an error when no more matches are found. +Then after repeating the search, wrap with `isearch-wrap-function'. +When `no', wrap immediately after reaching the last match. +When `no-ding', wrap immediately without flashing the screen. +When `nil', never wrap, just stop at the last match." + :type '(choice (const :tag "Pause before wrapping" t) + (const :tag "No pause before wrapping" no) + (const :tag "No pause and no flashing" no-ding) + (const :tag "Disable wrapping" nil)) + :version "28.1") + +(defcustom isearch-repeat-on-direction-change nil + "Whether a direction change should move to another match. +When `nil', the default, a direction change moves point to the other +end of the current search match. +When `t', a direction change moves to another search match, if there +is one." + :type '(choice (const :tag "Remain on the same match" nil) + (const :tag "Move to another match" t)) + :version "28.1") + (defvar isearch-mode-hook nil "Function(s) to call after starting up an incremental search.") @@ -1827,14 +1850,15 @@ Use `isearch-exit' to quit without signaling." ;; After taking the last element, adjust ring to previous one. (isearch-ring-adjust1 nil)) ;; If already have what to search for, repeat it. - (or isearch-success - (progn - ;; Set isearch-wrapped before calling isearch-wrap-function - (setq isearch-wrapped t) - (if isearch-wrap-function - (funcall isearch-wrap-function) - (goto-char (if isearch-forward (point-min) (point-max))))))) + (unless (or isearch-success (null isearch-wrap-pause)) + ;; Set isearch-wrapped before calling isearch-wrap-function + (setq isearch-wrapped t) + (if isearch-wrap-function + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max)))))) ;; C-s in reverse or C-r in forward, change direction. + (if (and isearch-other-end isearch-repeat-on-direction-change) + (goto-char isearch-other-end)) (setq isearch-forward (not isearch-forward) isearch-success t)) @@ -1844,7 +1868,8 @@ Use `isearch-exit' to quit without signaling." (setq isearch-success t) ;; For the case when count > 1, don't keep intermediate states ;; added to isearch-cmds by isearch-push-state in this loop. - (let ((isearch-cmds isearch-cmds)) + (let ((isearch-cmds isearch-cmds) + (was-success isearch-success)) (while (<= 0 (setq count (1- (or count 1)))) (if (and isearch-success (equal (point) isearch-other-end) @@ -1859,13 +1884,26 @@ Use `isearch-exit' to quit without signaling." (forward-char (if isearch-forward 1 -1)) (isearch-search)) (isearch-search)) - (when (> count 0) - ;; Update isearch-cmds, so if isearch-search fails later, - ;; it can restore old successful state from isearch-cmds. - (isearch-push-state)) - ;; Stop looping on failure. - (when (or (not isearch-success) isearch-error) - (setq count 0))))) + (when (> count 0) + ;; Update isearch-cmds, so if isearch-search fails later, + ;; it can restore old successful state from isearch-cmds. + (isearch-push-state)) + (cond + ;; Wrap immediately and repeat the search again + ((memq isearch-wrap-pause '(no no-ding)) + (if isearch-success + (setq was-success isearch-success) + ;; If failed this time after succeeding last time + (when was-success + (setq was-success nil) + (setq count (1+ count)) ;; Increment to force repeat + (setq isearch-wrapped t) + (if isearch-wrap-function + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max))))))) + ;; Stop looping on failure + (t (when (or (not isearch-success) isearch-error) + (setq count 0))))))) (isearch-push-state) (isearch-update)) @@ -1884,10 +1922,12 @@ of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument." (cond ((< count 0) (isearch-repeat-backward (abs count)) ;; Reverse the direction back - (isearch-repeat 'forward)) + (let ((isearch-repeat-on-direction-change nil)) + (isearch-repeat 'forward))) (t ;; Take into account one iteration to reverse direction - (when (not isearch-forward) (setq count (1+ count))) + (unless isearch-repeat-on-direction-change + (when (not isearch-forward) (setq count (1+ count)))) (isearch-repeat 'forward count)))) (isearch-repeat 'forward))) @@ -1905,10 +1945,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a numeric argument." (cond ((< count 0) (isearch-repeat-forward (abs count)) ;; Reverse the direction back - (isearch-repeat 'backward)) + (let ((isearch-repeat-on-direction-change nil)) + (isearch-repeat 'backward))) (t ;; Take into account one iteration to reverse direction - (when isearch-forward (setq count (1+ count))) + (unless isearch-repeat-on-direction-change + (when isearch-forward (setq count (1+ count)))) (isearch-repeat 'backward count)))) (isearch-repeat 'backward))) @@ -3012,6 +3054,10 @@ See more for options in `search-exit-option'." (goto-char isearch-pre-move-point)) (isearch-search-and-update))) (setq isearch-pre-move-point nil)) + ;; Terminate the search if point has moved to another buffer. + (unless (eq isearch--current-buffer (current-buffer)) + (when (buffer-live-p isearch--current-buffer) + (with-current-buffer isearch--current-buffer (isearch-exit)))) (force-mode-line-update)) (defun isearch-quote-char (&optional count) @@ -3488,10 +3534,10 @@ Optional third argument, if t, means if fail just return nil (no error). ;; stack overflow in regexp search. (setq isearch-error (format "%s" lossage)))) - (if isearch-success - nil + (unless isearch-success ;; Ding if failed this time after succeeding last time. (and (isearch--state-success (car isearch-cmds)) + (not (eq isearch-wrap-pause 'no-ding)) (ding)) (if (functionp (isearch--state-pop-fun (car isearch-cmds))) (funcall (isearch--state-pop-fun (car isearch-cmds)) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 8aebcd0ec4d..a6223646c11 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,7 +1,6 @@ -;;; jka-compr.el --- reading/writing/loading compressed files +;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-2021 Free Software Foundation, Inc. ;; Author: Jay K. Adams <jka@ece.cmu.edu> ;; Maintainer: emacs-devel@gnu.org @@ -120,7 +119,7 @@ data appears to be compressed already.") (widen) (erase-buffer) (insert (format "Error while executing \"%s %s < %s\"\n\n" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") infile)) (and errfile @@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning." (format "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file jka-compr-dd-program jka-compr-dd-blocksize @@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning." "-c" (format "%s %s 2> %s %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file (if (stringp output) (concat "> " output) @@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning." (jka-compr-error prog args infile message err-file)) (delete-file err-file))) (or (eq 0 - (apply 'call-process + (apply #'call-process prog infile (if (stringp output) temp output) nil args)) (jka-compr-error prog args infile message)) @@ -622,12 +621,12 @@ There should be no more than seven characters after the final `/'." (substring file 0 (string-match (jka-compr-info-regexp info) file))) file))) -(put 'write-region 'jka-compr 'jka-compr-write-region) -(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) -(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) -(put 'load 'jka-compr 'jka-compr-load) +(put 'write-region 'jka-compr #'jka-compr-write-region) +(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents) +(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy) +(put 'load 'jka-compr #'jka-compr-load) (put 'byte-compiler-base-file-name 'jka-compr - 'jka-compr-byte-compiler-base-file-name) + #'jka-compr-byte-compiler-base-file-name) ;;;###autoload (defvar jka-compr-inhibit nil @@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to anything but nil.") ;; to prevent the primitive from calling our handler again. (defun jka-compr-run-real-handler (operation args) (let ((inhibit-file-name-handlers - (cons 'jka-compr-handler + (cons #'jka-compr-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) @@ -674,7 +673,7 @@ by `jka-compr-installed'." (last fnha)) (while (cdr last) - (if (eq (cdr (car (cdr last))) 'jka-compr-handler) + (if (eq (cdr (car (cdr last))) #'jka-compr-handler) (setcdr last (cdr (cdr last))) (setq last (cdr last)))) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 59c002d3078..0b12bdad058 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -1,4 +1,4 @@ -;;; loadhist.el --- lisp functions for working with feature groups +;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc. diff --git a/lisp/loadup.el b/lisp/loadup.el index 650288f9f86..c82d08133cf 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,4 +1,4 @@ -;;; loadup.el --- load up standardly loaded Lisp files for Emacs +;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software ;; Foundation, Inc. @@ -112,7 +112,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal :size 80000))) + (setq purify-flag (make-hash-table :test #'equal :size 80000))) (message "Using load-path %s" load-path) @@ -134,7 +134,7 @@ ;; Do it after subr, since both after-load-functions and add-hook are ;; implemented in subr.el. -(add-hook 'after-load-functions (lambda (f) (garbage-collect))) +(add-hook 'after-load-functions (lambda (_) (garbage-collect))) (load "version") @@ -151,7 +151,7 @@ ;; variable its advertised default value (it starts as nil, see ;; xdisp.c). (setq resize-mini-windows 'grow-only) -(setq load-source-file-function 'load-with-code-conversion) +(setq load-source-file-function #'load-with-code-conversion) (load "files") ;; Load-time macro-expansion can only take effect after setting @@ -187,7 +187,7 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test 'equal))) +(let ((new (make-hash-table :test #'equal))) ;; Now that loaddefs has populated definition-prefixes, purify its contents. (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) definition-prefixes) @@ -400,7 +400,7 @@ lost after dumping"))) emacs-repository-branch (ignore-errors (emacs-repository-get-branch))) ;; A constant, so we shouldn't change it with `setq'. (defconst emacs-build-number - (if versions (1+ (apply 'max versions)) 1)))) + (if versions (1+ (apply #'max versions)) 1)))) (message "Finding pointers to doc strings...") @@ -430,11 +430,11 @@ lost after dumping"))) ;; We keep the load-history data in PURE space. ;; Make sure that the spine of the list is not in pure space because it can ;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar 'purecopy load-history)) +(setq load-history (mapcar #'purecopy load-history)) (set-buffer-modified-p nil) -(remove-hook 'after-load-functions (lambda (f) (garbage-collect))) +(remove-hook 'after-load-functions (lambda (_) (garbage-collect))) (if (boundp 'load--prefer-newer) (progn @@ -584,7 +584,7 @@ lost after dumping"))) ;; (or load-file-name byte-compile-current-file). (setq load-true-file-name nil) (setq load-file-name nil) -(eval top-level) +(eval top-level t) ;; Local Variables: diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index cdb994a5c8e..e08500a1898 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1402,7 +1402,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'. By default, this displays text and multipart messages, and offers to download attachments as specified by `rmail-mime-attachment-dirs-alist'. The arguments ARG and STATE have no effect in this case." - (interactive (list current-prefix-arg nil)) + (interactive) (if rmail-enable-mime (with-current-buffer rmail-buffer (if (or (rmail-mime-message-p) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index aece03ef0f3..cb8f8e34558 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -274,23 +274,23 @@ folder containing the index search results." t))) ;; Copy the search results over. - (maphash #'(lambda (folder msgs) - (let ((cur (car (mh-translate-range folder "cur"))) - (msgs (sort (cl-loop - for msg being the hash-keys of msgs - collect msg) - #'<))) - (mh-exec-cmd "refile" msgs "-src" folder - "-link" index-folder) - ;; Restore cur to old value, that refile changed - (when cur - (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" - "-sequence" - "cur" (format "%s" cur))) - (cl-loop for msg in msgs - do (cl-incf result-count) - (setf (gethash result-count origin-map) - (cons folder msg))))) + (maphash (lambda (folder msgs) + (let ((cur (car (mh-translate-range folder "cur"))) + (msgs (sort (cl-loop + for msg being the hash-keys of msgs + collect msg) + #'<))) + (mh-exec-cmd "refile" msgs "-src" folder + "-link" index-folder) + ;; Restore cur to old value, that refile changed + (when cur + (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" + "-sequence" + "cur" (format "%s" cur))) + (cl-loop for msg in msgs + do (cl-incf result-count) + (setf (gethash result-count origin-map) + (cons folder msg))))) folder-results-map) ;; Vist the results folder. @@ -1136,10 +1136,10 @@ REGEXP-LIST is an alist of fields and values." ((atom (cadr expr)) `(or (and ,expr))) ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* - `(or ,@(mapcar #'(lambda (x) `(not ,x)) + `(or ,@(mapcar (lambda (x) `(not ,x)) (cdadr expr))))) ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* - `(and ,@(mapcar #'(lambda (x) `(not ,x)) + `(and ,@(mapcar (lambda (x) `(not ,x)) (cdadr expr))))) (t (error "Unreachable: %s" expr)))) @@ -1620,7 +1620,7 @@ garbled." (cl-loop for seq in seq-list do (apply #'mh-exec-cmd "mark" mh-current-folder "-sequence" (symbol-name (car seq)) "-add" - (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) + (mapcar (lambda (x) (format "%s" x)) (cdr seq)))))) ;;;###mh-autoload (defun mh-create-sequence-map (seq-list) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index a7878aaae9b..01b6863038b 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -233,7 +233,7 @@ sibling." (push index msg-list))) (forward-line)) (mh-scan-folder mh-current-folder - (mapcar #'(lambda (x) (format "%s" x)) + (mapcar (lambda (x) (format "%s" x)) (mh-coalesce-msg-list msg-list)) t)) (when mh-index-data @@ -591,7 +591,7 @@ Only information about messages in MSG-LIST are added to the tree." #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil "-width" "10000" "-format" "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" - folder (mapcar #'(lambda (x) (format "%s" x)) msg-list))) + folder (mapcar (lambda (x) (format "%s" x)) msg-list))) (goto-char (point-min)) (let ((roots ()) (case-fold-search t)) @@ -635,9 +635,9 @@ Only information about messages in MSG-LIST are added to the tree." (mh-thread-remove-parent-link id) (mh-thread-add-link (car ancestors) id))) (mh-thread-add-link (car ancestors) (cadr ancestors))))))) - (maphash #'(lambda (_k v) - (when (null (mh-container-parent v)) - (push v roots))) + (maphash (lambda (_k v) + (when (null (mh-container-parent v)) + (push v roots))) mh-thread-id-table) (setq roots (mh-thread-prune-containers roots)) (prog1 (setq roots (mh-thread-group-by-subject roots)) @@ -720,25 +720,25 @@ For now it will take the last string inside angles." mh-thread-history) (mh-thread-remove-parent-link node))))) (let ((results ())) - (maphash #'(lambda (_k v) - (when (and (null (mh-container-parent v)) - (gethash (mh-message-id (mh-container-message v)) - mh-thread-id-index-map)) - (push v results))) + (maphash (lambda (_k v) + (when (and (null (mh-container-parent v)) + (gethash (mh-message-id (mh-container-message v)) + mh-thread-id-index-map)) + (push v results))) mh-thread-id-table) (mh-thread-sort-containers results)))) (defun mh-thread-sort-containers (containers) "Sort a list of message CONTAINERS to be in ascending order wrt index." (sort containers - #'(lambda (x y) - (when (and (mh-container-message x) (mh-container-message y)) - (let* ((id-x (mh-message-id (mh-container-message x))) - (id-y (mh-message-id (mh-container-message y))) - (index-x (gethash id-x mh-thread-id-index-map)) - (index-y (gethash id-y mh-thread-id-index-map))) - (and (integerp index-x) (integerp index-y) - (< index-x index-y))))))) + (lambda (x y) + (when (and (mh-container-message x) (mh-container-message y)) + (let* ((id-x (mh-message-id (mh-container-message x))) + (id-y (mh-message-id (mh-container-message y))) + (index-x (gethash id-x mh-thread-id-index-map)) + (index-y (gethash id-y mh-thread-id-index-map))) + (and (integerp index-x) (integerp index-y) + (< index-x index-y))))))) (defvar mh-thread-last-ancestor) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index be66e62a1d7..e73c1db9e45 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -544,8 +544,8 @@ nested folders within them." (mh-sub-folders-actual folder))) (t match)))) (if add-trailing-slash-flag - (mapcar #'(lambda (x) - (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) + (mapcar (lambda (x) + (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) sub-folders) sub-folders))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 5f594679ca3..c900b0d7ce6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -488,8 +488,17 @@ for use at QPOS." (qsuffix (cdr action)) (ufull (if (zerop (length qsuffix)) ustring (funcall unquote (concat string qsuffix)))) - (_ (cl-assert (string-prefix-p ustring ufull))) - (usuffix (substring ufull (length ustring))) + ;; If (not (string-prefix-p ustring ufull)) we have a problem: + ;; the unquoting the qfull gives something "unrelated" to ustring. + ;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see + ;; bug#47678). + ;; In that case we can't even tell if we're right before the + ;; "/" or right after it (aka if this "/" is from qstring or + ;; from qsuffix), which which usuffix to use is very unclear. + (usuffix (if (string-prefix-p ustring ufull) + (substring ufull (length ustring)) + ;; FIXME: Maybe "" is preferable/safer? + qsuffix)) (boundaries (completion-boundaries ustring table pred usuffix)) (qlboundary (car (funcall requote (car boundaries) string))) (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case. diff --git a/lisp/misearch.el b/lisp/misearch.el index 668c711922a..1f0dd315508 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -1,4 +1,4 @@ -;;; misearch.el --- isearch extensions for multi-buffer search +;;; misearch.el --- isearch extensions for multi-buffer search -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -28,6 +28,8 @@ ;;; Code: +(require 'cl-lib) + ;;; Search multiple buffers ;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -40,8 +42,7 @@ (defcustom multi-isearch-search t "Non-nil enables searching multiple related buffers, in certain modes." :type 'boolean - :version "23.1" - :group 'multi-isearch) + :version "23.1") (defcustom multi-isearch-pause t "A choice defining where to pause the search. @@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string." (const :tag "Don't pause" nil) (const :tag "Only in initial buffer" initial) (const :tag "All buffers" t)) - :version "23.1" - :group 'multi-isearch) + :version "23.1") ;;;###autoload (defvar multi-isearch-next-buffer-function nil @@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'." (default-value 'isearch-wrap-function) multi-isearch-orig-push-state (default-value 'isearch-push-state-function)) - (setq-default isearch-search-fun-function 'multi-isearch-search-fun - isearch-wrap-function 'multi-isearch-wrap - isearch-push-state-function 'multi-isearch-push-state) - (add-hook 'isearch-mode-end-hook 'multi-isearch-end))) + (setq-default isearch-search-fun-function #'multi-isearch-search-fun + isearch-wrap-function #'multi-isearch-wrap + isearch-push-state-function #'multi-isearch-push-state) + (add-hook 'isearch-mode-end-hook #'multi-isearch-end))) (defun multi-isearch-end () "Clean up the multi-buffer search after terminating isearch." @@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'." (setq-default isearch-search-fun-function multi-isearch-orig-search-fun isearch-wrap-function multi-isearch-orig-wrap isearch-push-state-function multi-isearch-orig-push-state) - (remove-hook 'isearch-mode-end-hook 'multi-isearch-end)) + (remove-hook 'isearch-mode-end-hook #'multi-isearch-end)) (defun multi-isearch-search-fun () "Return the proper search function, for isearch in multiple buffers." @@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (while (not (string-equal (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs :test #'equal) (setq ido-ignore-item-temp-list bufs)) (nreverse bufs))) @@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited by default-directory default-directory)) default-directory)) - (add-to-list 'files file)) + (cl-pushnew file files :test #'equal)) (nreverse files))) ;; A regexp is not the same thing as a file glob - does this matter? @@ -381,7 +381,7 @@ whose file names match the specified wildcard." (defun multi-isearch-unload-function () "Remove autoloaded variables from `unload-function-defs-list'. Also prevent the feature from being reloaded via `isearch-mode-hook'." - (remove-hook 'isearch-mode-hook 'multi-isearch-setup) + (remove-hook 'isearch-mode-hook #'multi-isearch-setup) (let ((defs (list (car unload-function-defs-list))) (auto '(multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function @@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'." ;; . nil)) -(defalias 'misearch-unload-function 'multi-isearch-unload-function) +(defalias 'misearch-unload-function #'multi-isearch-unload-function) (provide 'multi-isearch) diff --git a/lisp/msb.el b/lisp/msb.el index 14209d9956d..1064f940905 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,4 +1,4 @@ -;;; msb.el --- customizable buffer-selection with multiple menus +;;; msb.el --- customizable buffer-selection with multiple menus -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc. @@ -252,14 +252,12 @@ error every time you do \\[msb]." :type `(choice (const :tag "long" :value ,msb--very-many-menus) (const :tag "short" :value ,msb--few-menus) (sexp :tag "user")) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-modes-key 4000 "The sort key for files sorted by mode." :type 'integer - :set 'msb-custom-set - :group 'msb + :set #'msb-custom-set :version "20.3") (defcustom msb-separator-diff 100 @@ -267,8 +265,7 @@ error every time you do \\[msb]." The separators will appear between all menus that have a sorting key that differs by this value or more." :type '(choice integer (const nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-files-by-directory-sort-key 0 "The sort key for files sorted by directory.") @@ -278,8 +275,7 @@ that differs by this value or more." If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. A value of nil means no limit." :type '(choice integer (const nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-max-file-menu-items 10 "The maximum number of items from different directories. @@ -293,27 +289,23 @@ them together. If the value is not a number, then the value 10 is used." :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-most-recently-used-sort-key -1010 "Where should the menu with the most recently used buffers be placed?" :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-display-most-recently-used 15 "How many buffers should be in the most-recently-used menu. No buffers at all if less than 1 or nil (or any non-number)." :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-most-recently-used-title "Most recently used (%d)" "The title for the most-recently-used menu." :type 'string - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-horizontal-shift-function (lambda () 0) "Function that specifies how many pixels to shift the top menu leftwards.") @@ -323,8 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)." Non-nil means that the buffer menu should include buffers that have names that starts with a space character." :type 'boolean - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-item-handling-function 'msb-item-handler "The appearance of a buffer menu. @@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting (faster)." :type '(choice (const msb-sort-by-name) (const :tag "Newest first" t) (const :tag "Oldest first" nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-files-by-directory nil "Non-nil means that files should be sorted by directory. This is instead of the groups in `msb-menu-cond'." :type 'boolean - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (define-obsolete-variable-alias 'msb-after-load-hooks 'msb-after-load-hook "24.1") @@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'." (defcustom msb-after-load-hook nil "Hook run after the msb package has been loaded." :type 'hook - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (make-obsolete-variable 'msb-after-load-hook "use `with-eval-after-load' instead." "28.1") @@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)." ;;; ;;; msb -;;; -;;; This function can be used instead of (mouse-buffer-menu EVENT) -;;; function in "mouse.el". -;;; +;; +;; This function can be used instead of (mouse-buffer-menu EVENT) +;; function in "mouse.el". +;; (defun msb (event) "Pop up several menus of buffers for selection with the mouse. This command switches buffers in the window that you clicked on, and @@ -707,7 +695,7 @@ See `msb-menu-cond' for a description of its elements." (cl-loop for fi across function-info-vector if (and (setq result - (eval (aref fi 1))) ;Test CONDITION + (eval (aref fi 1) t)) ;Test CONDITION (not (and (eq result 'no-multi) multi-flag)) (progn (when (eq result 'multi) @@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) to the buffer-list variable in FUNCTION-INFO." (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE ;; Here comes the hairy side-effect! - (set list-symbol - (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER - buffer - max-buffer-name-length) - buffer) - (eval list-symbol))))) + (push (cons (funcall (aref function-info 4) ;ITEM-HANDLER + buffer + max-buffer-name-length) + buffer) + (symbol-value list-symbol)))) (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) "Select the appropriate menu for BUFFER." @@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO." (defun msb--create-sort-item (function-info) "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty." - (let ((buffer-list (eval (aref function-info 0)))) + (let ((buffer-list (symbol-value (aref function-info 0)))) (when buffer-list (let ((sorter (aref function-info 5)) ;SORTER (sort-key (aref function-info 2))) ;MENU-SORT-KEY @@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)." for value = (msb--create-sort-item elt) if value collect value)))) (setq menu - (mapcar 'cdr ;Remove the SORT-KEY + (mapcar #'cdr ;Remove the SORT-KEY ;; Sort the menus - not the items. (msb--add-separators (sort @@ -1113,8 +1100,8 @@ variable `msb-menu-cond'." (nconc (list (frame-parameter frame 'name) (frame-parameter frame 'name)) - `(lambda () - (interactive) (menu-bar-select-frame ,frame)))) + (lambda () + (interactive) (menu-bar-select-frame frame)))) frames))))) (setcdr global-buffers-menu-map (if (and buffers-menu frames-menu) @@ -1128,7 +1115,7 @@ variable `msb-menu-cond'." ;; C-down-mouse-1). (defvar msb-mode-map (let ((map (make-sparse-keymap "Msb"))) - (define-key map [remap mouse-buffer-menu] 'msb) + (define-key map [remap mouse-buffer-menu] #'msb) map)) ;;;###autoload @@ -1137,14 +1124,14 @@ variable `msb-menu-cond'." This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'." - :global t :group 'msb + :global t (if msb-mode (progn - (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) - (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers) + (add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers) + (remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers) (msb-menu-bar-update-buffers t)) - (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) - (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) + (remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers) + (add-hook 'menu-bar-update-hook #'menu-bar-update-buffers) (menu-bar-update-buffers t))) (defun msb-unload-function () diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 32fe857e65c..eec3ec7ba8b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -987,6 +987,7 @@ the like." (define-key map "F" 'eww-toggle-fonts) (define-key map "D" 'eww-toggle-paragraph-direction) (define-key map [(meta C)] 'eww-toggle-colors) + (define-key map [(meta I)] 'eww-toggle-images) (define-key map "b" 'eww-add-bookmark) (define-key map "B" 'eww-list-bookmarks) @@ -1015,6 +1016,7 @@ the like." ["List cookies" url-cookie-list t] ["Toggle fonts" eww-toggle-fonts t] ["Toggle colors" eww-toggle-colors t] + ["Toggle images" eww-toggle-images t] ["Character Encoding" eww-set-character-encoding] ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) map)) @@ -1893,6 +1895,14 @@ If CHARSET is nil then use UTF-8." "off")) (eww-reload)) +(defun eww-toggle-images () + "Toggle whether or not to display images." + (interactive nil eww-mode) + (setq shr-inhibit-images (not shr-inhibit-images)) + (eww-reload) + (message "Images are now %s" + (if shr-inhibit-images "off" "on"))) + ;;; Bookmarks code (defvar eww-bookmarks nil) diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index af12f6970a6..8992ef736a6 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -263,9 +263,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and ;;;###autoload (define-minor-mode goto-address-mode "Minor mode to buttonize URLs and e-mail addresses in the current buffer." - nil - "" - nil + :lighter "" (if goto-address-mode (jit-lock-register #'goto-address-fontify-region) (jit-lock-unregister #'goto-address-fontify-region) @@ -285,9 +283,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and ;;;###autoload (define-minor-mode goto-address-prog-mode "Like `goto-address-mode', but only for comments and strings." - nil - "" - nil + :lighter "" (if goto-address-prog-mode (jit-lock-register #'goto-address-fontify-region) (jit-lock-unregister #'goto-address-fontify-region) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 3a561a0ea51..24f2aba8b86 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -857,9 +857,14 @@ and `network-connection-service-alist', which see." ;; FIXME: modern whois clients include a much better tld <-> whois server ;; list, Emacs should probably avoid specifying the server as the client ;; will DTRT anyway... -rfr +;; I'm not sure about the above FIXME. It seems to me that we should +;; just check the Root Zone Database maintained at: +;; https://www.iana.org/domains/root/db +;; For example: whois -h whois.iana.org .se | grep whois (defcustom whois-server-tld - '(("rs.internic.net" . "com") - ("whois.publicinterestregistry.net" . "org") + '(("whois.verisign-grs.com" . "com") + ("whois.verisign-grs.com" . "net") + ("whois.pir.org" . "org") ("whois.ripe.net" . "be") ("whois.ripe.net" . "de") ("whois.ripe.net" . "dk") @@ -867,10 +872,13 @@ and `network-connection-service-alist', which see." ("whois.ripe.net" . "fi") ("whois.ripe.net" . "fr") ("whois.ripe.net" . "uk") + ("whois.iis.se" . "se") + ("whois.iis.nu" . "nu") ("whois.apnic.net" . "au") ("whois.apnic.net" . "ch") ("whois.apnic.net" . "hk") ("whois.apnic.net" . "jp") + ("whois.eu" . "eu") ("whois.nic.gov" . "gov") ("whois.nic.mil" . "mil")) "Alist to map top level domains to whois servers." diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 938fadfed74..7bb8ca671cf 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -196,7 +196,7 @@ If nil, no maximum is applied." Uninteresting lines are those whose responses are listed in `rcirc-omit-responses'." - nil " Omit" nil + :lighter " Omit" (if rcirc-omit-mode (progn (add-to-invisibility-spec '(rcirc-omit . nil)) @@ -1359,9 +1359,7 @@ Create the buffer if it doesn't exist." (define-minor-mode rcirc-multiline-minor-mode "Minor mode for editing multiple lines in rcirc." - :init-value nil :lighter " rcirc-mline" - :keymap rcirc-multiline-minor-mode-map :global nil (setq fill-column rcirc-max-message-length)) @@ -1863,9 +1861,6 @@ This function does not alter the INPUT string." ;;;###autoload (define-minor-mode rcirc-track-minor-mode "Global minor mode for tracking activity in rcirc buffers." - :init-value nil - :lighter "" - :keymap rcirc-track-minor-mode-map :global t (or global-mode-string (setq global-mode-string '(""))) ;; toggle the mode-line channel indicator diff --git a/lisp/net/shr.el b/lisp/net/shr.el index c122a19e90c..cbdeb65ba8b 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -183,8 +183,10 @@ temporarily blinks with this face." "Face for <abbr> elements." :version "27.1") -(defvar shr-inhibit-images nil - "If non-nil, inhibit loading images.") +(defcustom shr-inhibit-images nil + "If non-nil, inhibit loading images." + :version "28.1" + :type 'boolean) (defvar shr-external-rendering-functions nil "Alist of tag/function pairs used to alter how shr renders certain tags. @@ -313,6 +315,12 @@ DOM should be a parse tree as generated by (* (frame-char-width) 2)) 1)))) (max-specpdl-size max-specpdl-size) + ;; `bidi-display-reordering' is supposed to be only used for + ;; debugging purposes, but Shr's naïve filling algorithm + ;; cannot cope with the complexity of RTL text in an LTR + ;; paragraph, when a long line has been continued, and for + ;; most scripts the character metrics don't change when they + ;; are reordered, so... this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 499bf8abe41..0e6a2bb04af 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -169,7 +169,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -225,7 +226,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -389,14 +391,7 @@ The string is used in `tramp-methods'.") (regexp-opt '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) "\\'") - nil ,(user-login-name))) - - ;; MS Windows Openssh client does not cooperate well with cmdproxy. - (when-let ((encoding-shell - (and (eq system-type 'windows-nt) (executable-find "powershell")))) - (add-to-list 'tramp-connection-properties - `(,(regexp-opt '("/sshx:" "/scpx:")) - "encoding-shell" ,encoding-shell)))) + nil ,(user-login-name)))) ;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh @@ -406,16 +401,34 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh - '((tramp-parse-rhosts "/etc/hosts.equiv") + `((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") + ;; On W32 systems, the ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + "ssh/ssh_known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) + (tramp-parse-sconfig ,(expand-file-name + "ssh/ssh_config" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) (tramp-parse-shostkeys "/etc/ssh2/hostkeys") (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") (tramp-parse-rhosts "~/.rhosts") (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config") + ;; On W32 systems, the .ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + ".ssh/known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) + (tramp-parse-sconfig ,(expand-file-name + ".ssh/config" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) (tramp-parse-shostkeys "~/.ssh2/hostkeys") (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") @@ -438,7 +451,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty - ,(if (memq system-type '(windows-nt)) + ,(if (eq system-type 'windows-nt) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") @@ -491,7 +504,6 @@ shell from reading its init file." '((tramp-login-prompt-regexp tramp-action-login) (tramp-password-prompt-regexp tramp-action-password) (tramp-wrong-passwd-regexp tramp-action-permission-denied) - (tramp-no-job-control-regexp tramp-action-permission-denied) (shell-prompt-pattern tramp-action-succeed) (tramp-shell-prompt-pattern tramp-action-succeed) (tramp-yesno-prompt-regexp tramp-action-yesno) @@ -949,7 +961,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) @@ -1557,49 +1569,6 @@ ID-FORMAT valid values are `string' and `integer'." (or (tramp-check-cached-permissions v ?r) (tramp-run-test "-r" filename))))) -;; When the remote shell is started, it looks for a shell which groks -;; tilde expansion. Here, we assume that all shells which grok tilde -;; expansion will also provide a `test' command which groks `-nt' (for -;; newer than). If this breaks, tell me about it and I'll try to do -;; something smarter about it. -(defun tramp-sh-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond ((not (file-exists-p file1)) nil) - ((not (file-exists-p file2)) t) - (t ;; We are sure both files exist at this point. We try to - ;; get the mtime of both files. If they are not equal to - ;; the "dont-know" value, then we subtract the times and - ;; obtain the result. - (let ((fa1 (file-attributes file1)) - (fa2 (file-attributes file2))) - (if (and - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa1) - tramp-time-dont-know)) - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa2) - tramp-time-dont-know))) - (time-less-p - (tramp-compat-file-attribute-modification-time fa2) - (tramp-compat-file-attribute-modification-time fa1)) - ;; If one of them is the dont-know value, then we can - ;; still try to run a shell command on the remote host. - ;; However, this only works if both files are Tramp - ;; files and both have the same method, same user, same - ;; host. - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "Files %s and %s must have same method, user, host" - file1 file2))) - (with-parsed-tramp-file-name file1 nil - (tramp-run-test2 - (tramp-get-test-nt-command v) file1 file2))))))) - ;; Functions implemented using the basic functions above. (defun tramp-sh-handle-file-directory-p (filename) @@ -3959,24 +3928,6 @@ Returns the exit code of the `test' program." switch (tramp-shell-quote-argument localname))))) -(defun tramp-run-test2 (format-string file1 file2) - "Run `test'-like program on the remote system, given FILE1, FILE2. -FORMAT-STRING contains the program name, switches, and place holders. -Returns the exit code of the `test' program. Barfs if the methods, -hosts, or files, disagree." - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "tramp-run-test2 only implemented for same method, user, host"))) - (with-parsed-tramp-file-name file1 v1 - (with-parsed-tramp-file-name file1 v2 - (tramp-send-command-and-check - v1 - (format format-string - (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname)))))) - (defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) "Regexp to determine remote SunOS.") @@ -4865,6 +4816,8 @@ connection if a previous connection has died for some reason." (setenv "HISTSIZE" "0")))) (setenv "PROMPT_COMMAND") (setenv "PS1" tramp-initial-end-of-output) + (unless (stringp tramp-encoding-shell) + (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((current-host tramp-system-name) (target-alist (tramp-compute-multi-hops vec)) ;; We will apply `tramp-ssh-controlmaster-options' @@ -4876,23 +4829,17 @@ connection if a previous connection has died for some reason." ;; W32 systems. (process-coding-system-alist nil) (coding-system-for-read nil) - (encoding-shell - (tramp-get-connection-property - vec "encoding-shell" tramp-encoding-shell)) - (extra-args (tramp-get-sh-extra-args encoding-shell)) + (extra-args (tramp-get-sh-extra-args tramp-encoding-shell)) ;; This must be done in order to avoid our file ;; name handler. (p (let ((default-directory (tramp-compat-temporary-file-directory))) - (unless (stringp encoding-shell) - (tramp-error - vec 'file-error "`tramp-encoding-shell' not set")) (apply #'start-process (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) (append - (list encoding-shell) + (list tramp-encoding-shell) (and extra-args (split-string extra-args)) (and tramp-encoding-command-interactive (list tramp-encoding-command-interactive))))))) @@ -4911,7 +4858,8 @@ connection if a previous connection has died for some reason." ;; Check whether process is alive. (tramp-barf-if-no-shell-prompt - p 10 "Couldn't find local shell prompt for %s" encoding-shell) + p 10 + "Couldn't find local shell prompt for %s" tramp-encoding-shell) ;; Now do all the connections as specified. (while target-alist @@ -4986,7 +4934,7 @@ connection if a previous connection has died for some reason." ?c (format-spec options (format-spec-make ?t tmpfile)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("; exit"))) + (when r-shell '("&&" "exit" "||" "exit"))) " ")) ;; Send the command. @@ -5834,7 +5782,7 @@ function cell is returned to be applied on a buffer." ;; slashes as directory separators. (cond ((and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s | \"%s\")") ((string-match-p "local" prop) "(%s | %s)") (t "(%s | %s >%%s)")) @@ -5845,7 +5793,7 @@ function cell is returned to be applied on a buffer." ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. (if (and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s <%%s | \"%s\")" "(%s <%%s | %s)") compress coding)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 99955b54598..8da94ec9d9e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -488,7 +488,7 @@ interpreted as a regular expression which always matches." ;; either lower case or upper case letters. See ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>. (defcustom tramp-restricted-shell-hosts-alist - (when (memq system-type '(windows-nt)) + (when (eq system-type 'windows-nt) (list (format "\\`\\(%s\\|%s\\)\\'" (regexp-quote (downcase tramp-system-name)) (regexp-quote (upcase tramp-system-name))))) @@ -558,7 +558,7 @@ usually suffice.") the remote shell.") (defcustom tramp-local-end-of-line - (if (memq system-type '(windows-nt)) "\r\n" "\n") + (if (eq system-type 'windows-nt) "\r\n" "\n") "String used for end of line in local processes." :version "24.1" :type 'string) @@ -691,15 +691,6 @@ The regexp should match at end of buffer." :version "27.1" :type 'regexp) -;; Powershell requires "ssh -t -t" for terminal emulation. If it -;; doesn't fit, there is an error. -(defcustom tramp-no-job-control-regexp - (regexp-quote "Thus no job control in this shell.") - "Regular expression matching powershell's job control message. -The regexp should match at end of buffer." - :version "28.1" - :type 'regexp) - (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" (regexp-opt '("Operation not permitted") t)) @@ -1087,7 +1078,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") (defconst tramp-completion-file-name-regexp-default (concat - "\\`/\\(" + "\\`" + ;; `file-name-completion' uses absolute paths for matching. This + ;; means that on W32 systems, something like "/ssh:host:~/path" + ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]+:[^/|:]*|\\)*" ;; Last hop. @@ -1106,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-simplified (concat - "\\`/\\(" + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]*|\\)*" ;; Last hop. @@ -1122,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate - "\\`/\\(\\[[^]]*\\)?\\'" + (concat + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(\\[[^]]*\\)?\\'") "Value for `tramp-completion-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") @@ -3128,7 +3138,7 @@ User may be nil." (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. User is always nil." - (if (memq system-type '(windows-nt)) + (if (eq system-type 'windows-nt) (with-tramp-connection-property nil "parse-putty" (with-temp-buffer (when (zerop (tramp-call-process @@ -4980,7 +4990,7 @@ VEC is used for tracing." (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-temp-buffer - (unless (or (memq system-type '(windows-nt)) + (unless (or (eq system-type 'windows-nt) (not (zerop (tramp-call-process nil "locale" nil t nil "-a")))) (while candidates diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 7ffee762eb2..a630baf3543 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1336,7 +1336,7 @@ See the variable `iswitchb-case' for details." Iswitchb mode is a global minor mode that enables switching between buffers using substrings. See `iswitchb' for details." - nil nil iswitchb-global-map :global t + :keymap iswitchb-global-map :global t (if iswitchb-mode (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup) (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))) diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index 59828759e66..f999f507972 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -314,8 +314,6 @@ but before calling PC Selection mode): C-BACKSPACE backward-kill-word M-BACKSPACE undo" ;; FIXME: bring pc-bindings-mode here ? - nil nil nil - :global t (if pc-selection-mode diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index f40f2b335ef..7ae8fae3aab 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -521,7 +521,7 @@ for a capture buffer.") "Minor mode for special key bindings in a capture buffer. Turning on this mode runs the normal hook `org-capture-mode-hook'." - nil " Cap" org-capture-mode-map + :lighter " Cap" (setq-local header-line-format (substitute-command-keys diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index c6bf416564e..3475cadc42d 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -167,7 +167,7 @@ properties, after each buffer modification, on the modified zone. The process is synchronous. Though, initial indentation of buffer, which can take a few seconds on large buffers, is done during idle time." - nil " Ind" nil + :lighter " Ind" (cond (org-indent-mode ;; mode was turned on. diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 39122e7ce41..f97164ee33b 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -2304,7 +2304,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ;;;###autoload (define-minor-mode org-list-checkbox-radio-mode "When turned on, use list checkboxes as radio buttons." - nil " CheckBoxRadio" nil + :lighter " CheckBoxRadio" (unless (eq major-mode 'org-mode) (user-error "Cannot turn this mode outside org-mode buffers"))) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 20acee4e662..cabedecb689 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -682,7 +682,7 @@ This minor mode is turned on in two situations: \\{org-src-mode-map} See also `org-src-mode-hook'." - nil " OrgSrc" nil + :lighter " OrgSrc" (when org-edit-src-persistent-message (setq header-line-format (substitute-command-keys diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 1248efabc15..0e93fb271f3 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -495,7 +495,7 @@ This may be useful when columns have been shrunk." ;;;###autoload (define-minor-mode org-table-header-line-mode "Display the first row of the table at point in the header line." - nil " TblHeader" nil + :lighter " TblHeader" (unless (eq major-mode 'org-mode) (user-error "Cannot turn org table header mode outside org-mode buffers")) (if org-table-header-line-mode @@ -1976,7 +1976,7 @@ lines." When this mode is active, the field editor window will always show the current field. The mode exits automatically when the cursor leaves the table (but see `org-table-exit-follow-field-mode-when-leaving-table')." - nil " TblFollow" nil + :lighter " TblFollow" (if org-table-follow-field-mode (add-hook 'post-command-hook 'org-table-follow-fields-with-editor 'append 'local) @@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at point." ;;;###autoload (define-minor-mode orgtbl-mode "The Org mode table editor as a minor mode for use in other modes." - :lighter " OrgTbl" :keymap orgtbl-mode-map + :lighter " OrgTbl" (org-load-modules-maybe) (cond ((derived-mode-p 'org-mode) diff --git a/lisp/org/org.el b/lisp/org/org.el index cebe1735bed..f560c65dc4f 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -15584,7 +15584,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved This mode supports entering LaTeX environment and math in LaTeX fragments in Org mode. \\{org-cdlatex-mode-map}" - nil " OCDL" nil + :lighter " OCDL" (when org-cdlatex-mode (require 'cdlatex) (run-hooks 'cdlatex-mode-hook) diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 1a1732b6836..6ed95e84d6b 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -895,14 +895,16 @@ holding export options." ;;; Minor Mode -(defvar org-beamer-mode-map (make-sparse-keymap) +(defvar org-beamer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-b" 'org-beamer-select-environment) + map) "The keymap for `org-beamer-mode'.") -(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) ;;;###autoload (define-minor-mode org-beamer-mode "Support for editing Beamer oriented Org mode files." - nil " Bm" 'org-beamer-mode-map) + :lighter " Bm") (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords diff --git a/lisp/outline.el b/lisp/outline.el index 79029a6e5e7..bce9c6b9e4d 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -374,8 +374,9 @@ faces to major mode's faces." "Toggle Outline minor mode. See the command `outline-mode' for more information on this mode." - nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) - (cons outline-minor-mode-prefix outline-mode-prefix-map)) + :lighter " Outl" + :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map) + (cons outline-minor-mode-prefix outline-mode-prefix-map)) (if outline-minor-mode (progn (when (or outline-minor-mode-cycle outline-minor-mode-highlight) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 4d4becf780a..e467d98303e 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -440,9 +440,6 @@ and set it if applicable." ;;;###autoload (define-minor-mode bug-reference-mode "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." - nil - "" - nil :after-hook (bug-reference--run-auto-setup) (if bug-reference-mode (jit-lock-register #'bug-reference-fontify) @@ -454,9 +451,6 @@ and set it if applicable." ;;;###autoload (define-minor-mode bug-reference-prog-mode "Like `bug-reference-mode', but only buttonize in comments and strings." - nil - "" - nil :after-hook (bug-reference--run-auto-setup) (if bug-reference-prog-mode (jit-lock-register #'bug-reference-fontify) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 51d51deef71..9234d0b19b9 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1,4 +1,4 @@ -;;; cc-align.el --- custom indentation functions for CC Mode +;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -44,6 +44,9 @@ (cc-require 'cc-vars) (cc-require 'cc-engine) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + ;; Standard line-up functions ;; diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 32289443725..84cc5b115e7 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1,4 +1,4 @@ -;;; cc-awk.el --- AWK specific code within cc-mode. +;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 89ea1dca3b0..29634384dda 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -1,4 +1,4 @@ -;;; cc-bytecomp.el --- compile time setup for proper compilation +;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -85,8 +85,7 @@ (defvar cc-bytecomp-environment-set nil) -(defmacro cc-bytecomp-debug-msg (&rest args) - (ignore args) +(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed. ;;`(message ,@args) ) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 1754436d132..bee87b68499 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1,4 +1,4 @@ -;;; cc-cmds.el --- user level commands for CC Mode +;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -49,12 +49,11 @@ ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) (cc-bytecomp-defvar c-indent-to-body-directives) +(defvar c-syntactic-context) ;; Indentation / Display syntax functions (defvar c-fix-backslashes t) -(defvar c-syntactic-context) - (defun c-indent-line (&optional syntax quiet ignore-point-pos) "Indent the current line according to the syntactic context, if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the @@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal." (self-insert-command (prefix-numeric-value arg))) (setq final-pos (point)) -;;;; 2010-01-31: There used to be code here to put a syntax-table text -;;;; property on the new < or > and its mate (if any) when they are template -;;;; parens. This is now done in an after-change function. +;;;; 2010-01-31: There used to be code here to put a syntax-table text +;;;; property on the new < or > and its mate (if any) when they are template +;;;; parens. This is now done in an after-change function. (when (and (not arg) (not literal)) ;; Have we got a delimiter on a #include directive? @@ -1640,7 +1639,7 @@ No indentation or other \"electric\" behavior is performed." ;; This function might do hidden buffer changes. (save-excursion (let* (knr-start knr-res - decl-result brace-decl-p + decl-result (start (point)) (paren-state (c-parse-state)) (least-enclosing (c-least-enclosing-brace paren-state))) @@ -1670,12 +1669,19 @@ No indentation or other \"electric\" behavior is performed." (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t + ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already + ;; at a declaration. + (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" + (not (c-looking-at-non-alphnumspace))) + (forward-char)) + (if (and least-enclosing (eq (char-after least-enclosing) ?\()) (c-go-list-forward least-enclosing)) (c-forward-syntactic-ws) (setq knr-start (point)) - (if (c-syntactic-re-search-forward "{" nil t t) + (if (and (c-syntactic-re-search-forward "[;{]" nil t t) + (eq (char-before) ?\{)) (progn (backward-char) (cond @@ -1689,19 +1695,27 @@ No indentation or other \"electric\" behavior is performed." ((and knr-res (goto-char knr-res) (c-backward-syntactic-ws))) ; Always returns nil. - ((and (eq (char-before) ?\)) - (c-go-list-backward)) - (c-syntactic-skip-backward "^;" start t) - (if (eq (point) start) - (if (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\; ?} nil))) - (if (progn (c-forward-syntactic-ws) - (eq (point) start)) - 'at-header - 'outwith-function) - 'in-header) - 'outwith-function)) - (t 'outwith-function))) + (t + (when (eq (char-before) ?\)) + ;; The `c-go-list-backward' is a precaution against + ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda + ;; function inside the parentheses. + (c-go-list-backward)) + (setq decl-result + (car (c-beginning-of-decl-1 + (and least-enclosing + (c-safe-position + least-enclosing paren-state))))) + (cond + ((> (point) start) + 'outwith-function) + ((eq decl-result 'same) + (if (eq (point) start) + 'at-header + 'in-header)) + (t (error + "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s" + decl-result)))))) 'outwith-function)))))) (defun c-backward-to-nth-BOF-{ (n where) @@ -1810,12 +1824,14 @@ No indentation or other \"electric\" behavior is performed." nil))) (eval-and-compile - (defmacro c-while-widening-to-decl-block (condition) + (defmacro c-while-widening-to-decl-block (condition &optional no-where) ;; Repeatedly evaluate CONDITION until it returns nil. After each ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards ;; of the next enclosing declaration block (e.g. namespace, class), or the ;; buffer's original restriction. ;; + ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'. + ;; ;; This is a very special purpose macro, which assumes the existence of ;; several variables. It is for use only in c-beginning-of-defun and ;; c-end-of-defun. @@ -1826,7 +1842,8 @@ No indentation or other \"electric\" behavior is performed." (setq paren-state (c-whack-state-after lim paren-state)) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) - (setq where 'in-block)))) + ,@(if (not no-where) + `((setq where 'in-block)))))) (def-edebug-spec c-while-widening-to-decl-block t) @@ -2307,11 +2324,11 @@ with a brace block, at the outermost level of nesting." (c-save-buffer-state ((paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) - lim name limits where) + lim name limits) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) (and lim (setq lim (1- lim))) - (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) + (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t) (when name (setq limits (c-declaration-limits-1 near)) (cons name limits))) @@ -2927,10 +2944,13 @@ function does not require the declaration to contain a brace block." (c-looking-at-special-brace-list))) (or allow-early-stop (/= here last)) (save-excursion ; Is this a check that we're NOT at top level? -;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing -;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense. -;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g. -;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions. +;;;; NO! This seems to check that (i) EITHER we're at the top level; +;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM. +;;;; Doesn't seem to make sense. +;;;; 2003/8/8 This might have something to do with the GCC extension +;;;; "Statement Expressions", e.g. +;;;; while ({stmt1 ; stmt2 ; exp ;}). +;;;; This form excludes such Statement Expressions. (or (not (c-safe (up-list -1) t)) (= (char-after) ?{)))) (goto-char last) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 536e6766261..20dc97db5d7 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,4 +1,4 @@ -;;; cc-defs.el --- compile time definitions for CC Mode +;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index cc9833a434e..747a6fd4eda 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,4 +1,4 @@ -;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- +;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -163,6 +163,8 @@ (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) +(defvar c-syntactic-context) +(defvar c-syntactic-element) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -2717,9 +2719,9 @@ comment at the start of cc-engine.el for more info." ;; two char construct (such as a comment opener or an escaped character).) (if (and (consp elt) (>= (length elt) 3)) ;; Inside a string or comment - (let ((depth 0) (containing nil) (last nil) + (let ((depth 0) (containing nil) in-string in-comment - (min-depth 0) com-style com-str-start (intermediate nil) + (min-depth 0) com-style com-str-start (char-1 (nth 3 elt)) ; first char of poss. 2-char construct (pos (car elt)) (type (cadr elt))) @@ -2736,14 +2738,13 @@ comment at the start of cc-engine.el for more info." (1- pos) pos)) (if (memq 'pps-extended-state c-emacs-features) - (list depth containing last + (list depth containing nil in-string in-comment nil min-depth com-style com-str-start - intermediate nil) - (list depth containing last + nil nil) + (list depth containing nil in-string in-comment nil - min-depth com-style com-str-start - intermediate))) + min-depth com-style com-str-start nil))) ;; Not in a string or comment. (if (memq 'pps-extended-state c-emacs-features) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 4e283764ceb..433b4dcf4a8 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,4 +1,4 @@ -;;; cc-fonts.el --- font lock support for CC Mode +;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -2287,7 +2287,7 @@ need for `c-font-lock-extra-types'.") ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let (pos after-name) + (let (pos) (while (c-syntactic-re-search-forward c-using-key limit 'end) (while ; Do one declarator of a comma separated list, each time around. (progn @@ -2295,7 +2295,6 @@ need for `c-font-lock-extra-types'.") (setq pos (point)) ; token after "using". (when (and (c-on-identifier) (c-forward-name)) - (setq after-name (point)) (cond ((eq (char-after) ?=) ; using foo = <type-id>; (goto-char pos) @@ -2305,7 +2304,8 @@ need for `c-font-lock-extra-types'.") (c-go-up-list-backward) (eq (char-after) ?{) (eq (car (c-beginning-of-decl-1 - (c-determine-limit 1000))) 'same) + (c-determine-limit 1000))) + 'same) (looking-at c-colon-type-list-re))) ;; Inherited protected member: leave unfontified ) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index 1b852ec4910..0824af66b43 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -1,4 +1,4 @@ -;;; cc-guess.el --- guess indentation values by scanning existing code +;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 7819617bcf6..4266600f8cf 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1,4 +1,4 @@ -;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- +;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -580,14 +580,12 @@ don't have EOL terminated statements. " (c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) (c-lang-defconst c-vsemi-status-unknown-p-fn - "Contains a predicate regarding the presence of virtual semicolons. -More precisely, the function answers the question, \"are we unsure whether a -virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of -such a function is to prevent an infinite recursion in -`c-beginning-of-statement-1' when point starts at a `while' token. The function -MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even -indirectly. This variable contains nil for languages which don't have EOL -terminated statements." + "A function \"are we unsure whether there is a virtual semicolon on this line?\". +The (admittedly kludgy) purpose of such a function is to prevent an infinite +recursion in c-beginning-of-statement-1 when point starts at a `while' token. +The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', +even indirectly. This variable contains nil for languages which don't have +EOL terminated statements." t nil (c c++ objc) 'c-macro-vsemi-status-unknown-p awk 'c-awk-vsemi-status-unknown-p) diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 0ff6efb7d37..a099ec1de95 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -1,4 +1,4 @@ -;;; cc-menus.el --- imenu support for CC Mode +;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index cfb23d0d45e..dae0062efb5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,4 +1,4 @@ -;;; cc-mode.el --- major mode for editing C and similar languages +;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 29cbe54c3bd..77cad77711a 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -1,4 +1,4 @@ -;;; cc-styles.el --- support for styles in CC Mode +;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil." offset)) ;;;###autoload -(defun c-set-offset (symbol offset &optional ignored) +(defun c-set-offset (symbol offset &optional _ignored) "Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. The optional argument is not used diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 88ee092da79..b33fea0b48c 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1,4 +1,4 @@ -;;; cc-vars.el --- user customization variables for CC Mode +;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -42,6 +42,9 @@ (cc-require 'cc-defs) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + (cc-eval-when-compile (require 'custom) (require 'widget)) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 820867ab41f..edcd88ce24e 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -1,7 +1,6 @@ -;;; cmacexp.el --- expand C macros in a region +;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2021 Free Software Foundation, Inc. ;; Author: Francesco Potortì <pot@gnu.org> ;; Adapted-By: ESR @@ -33,20 +32,20 @@ ;; USAGE ============================================================= -;; In C mode C-C C-e is bound to c-macro-expand. The result of the +;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the ;; expansion is put in a separate buffer. A user option allows the ;; window displaying the buffer to be optimally sized. ;; -;; When called with a C-u prefix, c-macro-expand replaces the selected +;; When called with a C-u prefix, `c-macro-expand' replaces the selected ;; region with the expansion. Both the preprocessor name and the -;; initial flag can be set by the user. If c-macro-prompt-flag is set +;; initial flag can be set by the user. If `c-macro-prompt-flag' is set ;; to a non-nil value the user is offered to change the options to the -;; preprocessor each time c-macro-expand is invoked. Preprocessor -;; arguments default to the last ones entered. If c-macro-prompt-flag +;; preprocessor each time `c-macro-expand' is invoked. Preprocessor +;; arguments default to the last ones entered. If `c-macro-prompt-flag' ;; is nil, one must use M-x set-variable to set a different value for -;; c-macro-cppflags. +;; `c-macro-cppflags'. -;; A c-macro-expansion function is provided for non-interactive use. +;; A `c-macro-expansion' function is provided for non-interactive use. ;; INSTALLATION ====================================================== @@ -54,18 +53,22 @@ ;; If you want the *Macroexpansion* window to be not higher than ;; necessary: -;;(setq c-macro-shrink-window-flag t) +;; +;; (setq c-macro-shrink-window-flag t) ;; ;; If you use a preprocessor other than /lib/cpp (be careful to set a ;; -C option or equivalent in order to make the preprocessor not to ;; strip the comments): -;;(setq c-macro-preprocessor "gpp -C") +;; +;; (setq c-macro-preprocessor "gpp -C") ;; ;; If you often use a particular set of flags: -;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" +;; +;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG" ;; ;; If you want the "Preprocessor arguments: " prompt: -;;(setq c-macro-prompt-flag t) +;; +;; (setq c-macro-prompt-flag t) ;; BUG REPORTS ======================================================= @@ -87,16 +90,12 @@ (require 'cc-mode) -(provide 'cmacexp) - (defvar msdos-shells) - (defgroup c-macro nil "Expand C macros in a region." :group 'c) - (defcustom c-macro-shrink-window-flag nil "Non-nil means shrink the *Macroexpansion* window to fit its contents." :type 'boolean) @@ -392,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the echo area." ;; Cleanup. (kill-buffer outbuf)))) +(provide 'cmacexp) + ;;; cmacexp.el ends here diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 411ab558413..a690d4bceb3 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -512,7 +512,7 @@ functions are annotated with \"<f>\" via the (end (unless (or (eq beg (point-max)) (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) + '(?\" ?\())) (condition-case nil (save-excursion (goto-char beg) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 8481a27775f..e10602ab081 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -741,7 +741,10 @@ to handle a report even if TOKEN was not expected. REGION is a (BEG . END) pair of buffer positions indicating that this report applies to that region." (let* ((state (gethash backend flymake--backend-state)) - (first-report (not (flymake--backend-state-reported-p state)))) + first-report) + (unless state + (error "Can't find state for %s in `flymake--backend-state'" backend)) + (setf first-report (not (flymake--backend-state-reported-p state))) (setf (flymake--backend-state-reported-p state) t) (let (expected-token new-diags) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 910f70db03c..a819e7243ca 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1338,28 +1338,36 @@ made from `project-switch-commands'. When called in a program, it will use the project corresponding to directory DIR." (interactive (list (project-prompt-project-dir))) - (let ((commands-menu - (mapcar - (lambda (row) - (if (characterp (car row)) - ;; Deprecated format. - ;; XXX: Add a warning about it? - (reverse row) - row)) - project-switch-commands)) - command) + (let* ((commands-menu + (mapcar + (lambda (row) + (if (characterp (car row)) + ;; Deprecated format. + ;; XXX: Add a warning about it? + (reverse row) + row)) + project-switch-commands)) + (commands-map + (let ((temp-map (make-sparse-keymap))) + (set-keymap-parent temp-map project-prefix-map) + (dolist (row commands-menu temp-map) + (when-let ((cmd (nth 0 row)) + (keychar (nth 2 row))) + (define-key temp-map (vector keychar) cmd))))) + command) (while (not command) - (let ((choice (read-event (project--keymap-prompt)))) - (when (setq command - (or (car - (seq-find (lambda (row) (equal choice (nth 2 row))) - commands-menu)) - (lookup-key project-prefix-map (vector choice)))) + (let ((overriding-local-map commands-map) + (choice (read-key-sequence (project--keymap-prompt)))) + (when (setq command (lookup-key commands-map choice)) (unless (or project-switch-use-entire-map (assq command commands-menu)) ;; TODO: Add some hint to the prompt, like "key not ;; recognized" or something. - (setq command nil))))) + (setq command nil))) + (let ((global-command (lookup-key (current-global-map) choice))) + (when (memq global-command + '(keyboard-quit keyboard-escape-quit)) + (call-interactively global-command))))) (let ((default-directory dir) (project-current-inhibit-prompt t)) (call-interactively command)))) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 598f748f5b3..67c034d0905 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -1,4 +1,4 @@ -;;; ps-mode.el --- PostScript mode for GNU Emacs +;;; ps-mode.el --- PostScript mode for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc. @@ -281,20 +281,20 @@ If nil, use `temporary-file-directory'." (defvar ps-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-v" 'ps-run-boundingbox) - (define-key map "\C-c\C-u" 'ps-mode-uncomment-region) - (define-key map "\C-c\C-t" 'ps-mode-epsf-rich) - (define-key map "\C-c\C-s" 'ps-run-start) - (define-key map "\C-c\C-r" 'ps-run-region) - (define-key map "\C-c\C-q" 'ps-run-quit) - (define-key map "\C-c\C-p" 'ps-mode-print-buffer) - (define-key map "\C-c\C-o" 'ps-mode-comment-out-region) - (define-key map "\C-c\C-k" 'ps-run-kill) - (define-key map "\C-c\C-j" 'ps-mode-other-newline) - (define-key map "\C-c\C-l" 'ps-run-clear) - (define-key map "\C-c\C-b" 'ps-run-buffer) + (define-key map "\C-c\C-v" #'ps-run-boundingbox) + (define-key map "\C-c\C-u" #'ps-mode-uncomment-region) + (define-key map "\C-c\C-t" #'ps-mode-epsf-rich) + (define-key map "\C-c\C-s" #'ps-run-start) + (define-key map "\C-c\C-r" #'ps-run-region) + (define-key map "\C-c\C-q" #'ps-run-quit) + (define-key map "\C-c\C-p" #'ps-mode-print-buffer) + (define-key map "\C-c\C-o" #'ps-mode-comment-out-region) + (define-key map "\C-c\C-k" #'ps-run-kill) + (define-key map "\C-c\C-j" #'ps-mode-other-newline) + (define-key map "\C-c\C-l" #'ps-run-clear) + (define-key map "\C-c\C-b" #'ps-run-buffer) ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead? - (define-key map "\177" 'ps-mode-backward-delete-char) + (define-key map "\177" #'ps-mode-backward-delete-char) map) "Local keymap to use in PostScript mode.") @@ -336,10 +336,10 @@ If nil, use `temporary-file-directory'." (defvar ps-run-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map comint-mode-map) - (define-key map "\C-c\C-q" 'ps-run-quit) - (define-key map "\C-c\C-k" 'ps-run-kill) - (define-key map "\C-c\C-e" 'ps-run-goto-error) - (define-key map [mouse-2] 'ps-run-mouse-goto-error) + (define-key map "\C-c\C-q" #'ps-run-quit) + (define-key map "\C-c\C-k" #'ps-run-kill) + (define-key map "\C-c\C-e" #'ps-run-goto-error) + (define-key map [mouse-2] #'ps-run-mouse-goto-error) map) "Local keymap to use in PostScript run mode.") @@ -1092,7 +1092,7 @@ Use line numbers if `ps-run-error-line-numbers' is not nil." ;; -(add-hook 'kill-emacs-hook 'ps-run-cleanup) +(add-hook 'kill-emacs-hook #'ps-run-cleanup) (provide 'ps-mode) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e5c15d148f8..30721c7a577 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3385,7 +3385,8 @@ user-friendly message if there's no process running; defaults to t when called interactively." (interactive "p") (pop-to-buffer - (process-buffer (python-shell-get-process-or-error msg)) nil t)) + (process-buffer (python-shell-get-process-or-error msg)) + nil 'mark-for-redisplay)) (defun python-shell-send-setup-code () "Send all setup code for shell. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ba59f9c6616..c6bd32a4a4b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2967,7 +2967,7 @@ The document is bounded by `sh-here-document-word'." (define-minor-mode sh-electric-here-document-mode "Make << insert a here document skeleton." - nil nil nil + :lighter nil (if sh-electric-here-document-mode (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t) (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6224b3b5f3f..6e53a04f72d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1545,9 +1545,7 @@ statement. The format of variable should be a valid ;; `sql-font-lock-keywords-builder' function and follow the ;; implementation pattern used for the other products in this file. -(eval-when-compile - (defvar sql-mode-ansi-font-lock-keywords) - (setq sql-mode-ansi-font-lock-keywords nil)) +(defvar sql-mode-ansi-font-lock-keywords) (eval-and-compile (defun sql-font-lock-keywords-builder (face boundaries &rest keywords) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index a7f72950b10..2b88120eb9c 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2021.03.30.243771231 +;; Version: 2021.04.12.188864585 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2021-03-30-e87a75f-vpo-GNU" +(defconst verilog-mode-version "2021-04-12-b41d849-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -3607,7 +3607,7 @@ inserted using a single call to `verilog-insert'." ;; More searching (defun verilog-declaration-end () - (search-forward ";")) + (search-forward ";" nil t)) (defun verilog-single-declaration-end (limit) "Returns pos where current (single) declaration statement ends. @@ -7555,25 +7555,25 @@ will be completed at runtime and should not be added to this list.") TYPE is `module', `tf' for task or function, or t if unknown." (if (string= verilog-str "") (setq verilog-str "[a-zA-Z_]")) - (let ((verilog-str (concat (cond - ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") - ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") - (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) - "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) + (let ((verilog-str + (concat (cond + ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") + ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") + (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) + "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) match) - (if (not (looking-at verilog-defun-re)) - (verilog-re-search-backward verilog-defun-re nil t)) - (forward-char 1) + (save-excursion + (if (not (looking-at verilog-defun-re)) + (verilog-re-search-backward verilog-defun-re nil t)) + (forward-char 1) - ;; Search through all reachable functions - (goto-char (point-min)) - (while (verilog-re-search-forward verilog-str (point-max) t) - (progn (setq match (buffer-substring (match-beginning 2) - (match-end 2))) - (setq verilog-all (cons match verilog-all)))) - (if (match-beginning 0) - (goto-char (match-beginning 0))))) + ;; Search through all reachable functions + (goto-char (point-min)) + (while (verilog-re-search-forward verilog-str (point-max) t) + (setq match (buffer-substring (match-beginning 2) + (match-end 2))) + (setq verilog-all (cons match verilog-all)))))) (defun verilog-get-completion-decl (end) "Macro for searching through current declaration (var, type or const) @@ -11561,6 +11561,7 @@ See the example in `verilog-auto-inout-modport'." (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning +(defvar vl-memory nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning @@ -12063,6 +12064,7 @@ Lisp Templates: vl-width Width of the input/output port (`3' for [2:0]). May be a (...) expression if bits isn't a constant. vl-dir Direction of the pin input/output/inout/interface. + vl-memory The unpacked array part of the I/O port (`[5:0]'). vl-modport The modport, if an interface with a modport. vl-cell-type Module name/type of the cell (`InstModule'). vl-cell-name Instance name of the cell (`instName'). diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 856432ccf10..5eeac8af3b8 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -1,4 +1,4 @@ -;;; vhdl-mode.el --- major mode for editing VHDL code +;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*- ;; Copyright (C) 1992-2021 Free Software Foundation, Inc. @@ -12,6 +12,9 @@ ;; file on 18/3/2008, and the maintainer agreed that when a bug is ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. +;; +;; Reto also said in Apr 2021 that he preferred to keep the XEmacs +;; compatibility code. (defconst vhdl-version "3.38.1" "VHDL Mode version number.") @@ -77,7 +80,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation -;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. +;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21. ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation ;; or into an arbitrary directory that is added to the load path by the @@ -92,7 +95,7 @@ ;; Add the following lines to the `site-start.el' file in the `site-lisp' ;; directory of your Emacs installation or to your Emacs start-up file `.emacs' -;; (not required in Emacs 20 and higher): +;; (not required in Emacs): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) ;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) @@ -136,12 +139,9 @@ (when (< emacs-major-version 25) (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) -;; Emacs 21+ handling -(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 21, 22, ... is used.") ;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 22, ... is used.") + "Non-nil if GNU Emacs >= 22, ... is used.") (defvar compilation-file-regexp-alist) (defvar conf-alist) @@ -490,7 +490,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Upcase" upcase) (const :tag "Downcase" downcase)))))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + (vhdl-custom-set variable value #'vhdl-update-mode-menu)) :version "24.4" :group 'vhdl-compile) @@ -668,8 +668,8 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' :format "%t\n%v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-update-mode-menu - 'vhdl-speedbar-refresh)) + #'vhdl-update-mode-menu + #'vhdl-speedbar-refresh)) :group 'vhdl-project) (defcustom vhdl-project nil @@ -713,7 +713,7 @@ All project setup files that match the file names specified in option \(alphabetically) last loaded setup of the first `vhdl-project-file-name' entry is activated. A project setup file can be obtained by exporting a project (see menu). - At startup: project setup file is loaded at Emacs startup" + At startup: project setup file is loaded at Emacs startup." :type '(set (const :tag "At startup" startup)) :group 'vhdl-project) @@ -751,12 +751,12 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (const :tag "Math packages" math))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-template-map-init - 'vhdl-mode-abbrev-table-init - 'vhdl-template-construct-alist-init - 'vhdl-template-package-alist-init - 'vhdl-update-mode-menu - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-template-map-init + #'vhdl-mode-abbrev-table-init + #'vhdl-template-construct-alist-init + #'vhdl-template-package-alist-init + #'vhdl-update-mode-menu + #'vhdl-words-init 'vhdl-font-lock-init)) :group 'vhdl-style) (defcustom vhdl-basic-offset 2 @@ -770,7 +770,7 @@ This value is used by + and - symbols in `vhdl-offsets-alist'." This is done when typed or expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-types nil @@ -778,7 +778,7 @@ This is done when typed or expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-attributes nil @@ -786,7 +786,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-enum-values nil @@ -794,7 +794,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-constants t @@ -802,7 +802,7 @@ This is done when expanded or by the fix case functions." This is done when expanded." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-use-direct-instantiation 'standard @@ -909,7 +909,7 @@ follows: :type '(set (const :tag "VHDL keywords" vhdl) (const :tag "User model keywords" user)) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) + (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init)) :group 'vhdl-template) (defcustom vhdl-optional-labels 'process @@ -1192,10 +1192,10 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (string :tag "Keyword " :format "%t: %v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-model-map-init - 'vhdl-model-defun - 'vhdl-mode-abbrev-table-init - 'vhdl-update-mode-menu)) + #'vhdl-model-map-init + #'vhdl-model-defun + #'vhdl-mode-abbrev-table-init + #'vhdl-update-mode-menu)) :group 'vhdl-model) @@ -1598,7 +1598,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-names t @@ -1615,7 +1615,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-special-words nil @@ -1628,7 +1628,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-forbidden-words nil @@ -1643,7 +1643,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-verilog-keywords nil @@ -1656,7 +1656,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-translate-off nil @@ -1670,7 +1670,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-case-sensitive nil @@ -1724,7 +1724,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu (string :tag "Color (dark) ") (boolean :tag "In comments "))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-words '() @@ -1737,7 +1737,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-syntax "" @@ -1752,7 +1752,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'regexp :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") @@ -1763,7 +1763,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) @@ -2238,11 +2238,11 @@ Ignore byte-compiler warnings you might see." ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") (defun regexp-opt (strings &optional paren) (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat 'regexp-quote strings "\\|") close)))) + (concat open (mapconcat #'regexp-quote strings "\\|") close)))) ;; `match-string-no-properties' undefined (XEmacs, what else?) (unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) + (defalias 'match-string-no-properties #'match-string)) ;; `subst-char-in-string' undefined (XEmacs) (unless (fboundp 'subst-char-in-string) @@ -2269,7 +2269,7 @@ Ignore byte-compiler warnings you might see." (let* ((nondir (file-name-nondirectory pattern)) (dirpart (file-name-directory pattern)) (dirs (if (and dirpart (string-match "[[*?]" dirpart)) - (mapcar 'file-name-as-directory + (mapcar #'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) contents) @@ -2296,7 +2296,7 @@ Ignore byte-compiler warnings you might see." ;; `member-ignore-case' undefined (XEmacs) (unless (fboundp 'member-ignore-case) - (defalias 'member-ignore-case 'member)) + (defalias 'member-ignore-case #'member)) ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different ;; behavior in XEmacs @@ -2495,6 +2495,7 @@ current buffer if no project is defined." "Enable case insensitive search and switch to syntax table that includes `_', then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t)) ; case insensitive search ;; use extended syntax table (with-syntax-table vhdl-mode-ext-syntax-table @@ -2504,55 +2505,59 @@ consistent searching." "Enable case insensitive search, switch to syntax table that includes `_', arrange to ignore `intangible' overlays, then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t) ; case insensitive search - (current-syntax-table (syntax-table)) (inhibit-point-motion-hooks t)) ;; use extended syntax table - (set-syntax-table vhdl-mode-ext-syntax-table) - ;; execute BODY safely - (unwind-protect - (progn ,@body) - ;; restore syntax table - (set-syntax-table current-syntax-table)))) + (with-syntax-table vhdl-mode-ext-syntax-table + ;; execute BODY safely + (progn ,@body)))) (defmacro vhdl-visit-file (file-name issue-error &rest body) "Visit file FILE-NAME and execute BODY." - `(if (null ,file-name) - (progn ,@body) - (unless (file-directory-p ,file-name) - (let ((source-buffer (current-buffer)) - (visiting-buffer (find-buffer-visiting ,file-name)) - file-opened) - (when (or (and visiting-buffer (set-buffer visiting-buffer)) - (condition-case () - (progn (set-buffer (create-file-buffer ,file-name)) - (setq file-opened t) - (vhdl-insert-file-contents ,file-name) - ;; FIXME: This modifies a global syntax-table! - (modify-syntax-entry ?\- ". 12" (syntax-table)) - (modify-syntax-entry ?\n ">" (syntax-table)) - (modify-syntax-entry ?\^M ">" (syntax-table)) - (modify-syntax-entry ?_ "w" (syntax-table)) - t) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) - (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) - nil)))) - (condition-case info - (progn ,@body) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error (cadr info))) - (vhdl-warning (cadr info)))))) - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer))))) + (declare (debug t) (indent 2)) + `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body))) + +(defun vhdl--visit-file (file-name issue-error body-fun) + (if (null file-name) + (funcall body-fun) + (unless (file-directory-p file-name) + (let ((source-buffer (current-buffer)) + (visiting-buffer (find-buffer-visiting file-name)) + file-opened) + (when (or (and visiting-buffer (set-buffer visiting-buffer)) + (condition-case () + (progn (set-buffer (create-file-buffer file-name)) + (setq file-opened t) + (vhdl-insert-file-contents file-name) + (let ((st (copy-syntax-table (syntax-table)))) + (modify-syntax-entry ?\- ". 12" st) + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\^M ">" st) + (modify-syntax-entry ?_ "w" st) + ;; FIXME: We should arguably reset the + ;; syntax-table after running `body-fun'. + (set-syntax-table st)) + t) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error "ERROR: File cannot be opened: \"%s\"" file-name)) + (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t) + nil)))) + (condition-case info + (funcall body-fun) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error (cadr info))) + (vhdl-warning (cadr info)))))) + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer))))) (defun vhdl-insert-file-contents (filename) "Nicked from `insert-file-contents-literally', but allow coding system @@ -2600,7 +2605,7 @@ conversion." "Refresh directory or project with name KEY." (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (let ((pos (point)) + (let (;; (pos (point)) (last-frame (selected-frame))) (if (null key) (speedbar-refresh) @@ -2677,96 +2682,96 @@ elements > `vhdl-menu-max-size'." "Initialize `vhdl-template-map'." (setq vhdl-template-map (make-sparse-keymap)) ;; key bindings for VHDL templates - (define-key vhdl-template-map "al" 'vhdl-template-alias) - (define-key vhdl-template-map "ar" 'vhdl-template-architecture) - (define-key vhdl-template-map "at" 'vhdl-template-assert) - (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) - (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) - (define-key vhdl-template-map "bl" 'vhdl-template-block) - (define-key vhdl-template-map "ca" 'vhdl-template-case-is) - (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) - (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) - (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) - (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) - (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) - (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) - (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) - (define-key vhdl-template-map "co" 'vhdl-template-constant) - (define-key vhdl-template-map "ct" 'vhdl-template-context) - (define-key vhdl-template-map "di" 'vhdl-template-disconnect) - (define-key vhdl-template-map "el" 'vhdl-template-else) - (define-key vhdl-template-map "ei" 'vhdl-template-elsif) - (define-key vhdl-template-map "en" 'vhdl-template-entity) - (define-key vhdl-template-map "ex" 'vhdl-template-exit) - (define-key vhdl-template-map "fi" 'vhdl-template-file) - (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) - (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) - (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) - (define-key vhdl-template-map "fb" 'vhdl-template-function-body) - (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) - (define-key vhdl-template-map "ge" 'vhdl-template-generic) - (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) - (define-key vhdl-template-map "gt" 'vhdl-template-group-template) - (define-key vhdl-template-map "\C-h" 'vhdl-template-header) - (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) - (define-key vhdl-template-map "it" 'vhdl-template-if-then) - (define-key vhdl-template-map "li" 'vhdl-template-library) - (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) - (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) - (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) - (define-key vhdl-template-map "ma" 'vhdl-template-map) - (define-key vhdl-template-map "ne" 'vhdl-template-next) - (define-key vhdl-template-map "ot" 'vhdl-template-others) - (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) - (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) - (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) - (define-key vhdl-template-map "po" 'vhdl-template-port) - (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) - (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) - (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) - (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) - (define-key vhdl-template-map "rp" 'vhdl-template-report) - (define-key vhdl-template-map "rt" 'vhdl-template-return) - (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) - (define-key vhdl-template-map "si" 'vhdl-template-signal) - (define-key vhdl-template-map "su" 'vhdl-template-subtype) - (define-key vhdl-template-map "ty" 'vhdl-template-type) - (define-key vhdl-template-map "us" 'vhdl-template-use) - (define-key vhdl-template-map "va" 'vhdl-template-variable) - (define-key vhdl-template-map "wa" 'vhdl-template-wait) - (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) - (define-key vhdl-template-map "wi" 'vhdl-template-with) - (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) - (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) - (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) - (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) - (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) - (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) - (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) - (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) - (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) - (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) - (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) - (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) - (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) - (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) - (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) + (define-key vhdl-template-map "al" #'vhdl-template-alias) + (define-key vhdl-template-map "ar" #'vhdl-template-architecture) + (define-key vhdl-template-map "at" #'vhdl-template-assert) + (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl) + (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec) + (define-key vhdl-template-map "bl" #'vhdl-template-block) + (define-key vhdl-template-map "ca" #'vhdl-template-case-is) + (define-key vhdl-template-map "cd" #'vhdl-template-component-decl) + (define-key vhdl-template-map "ci" #'vhdl-template-component-inst) + (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst) + (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration) + (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf) + (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl) + (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec) + (define-key vhdl-template-map "co" #'vhdl-template-constant) + (define-key vhdl-template-map "ct" #'vhdl-template-context) + (define-key vhdl-template-map "di" #'vhdl-template-disconnect) + (define-key vhdl-template-map "el" #'vhdl-template-else) + (define-key vhdl-template-map "ei" #'vhdl-template-elsif) + (define-key vhdl-template-map "en" #'vhdl-template-entity) + (define-key vhdl-template-map "ex" #'vhdl-template-exit) + (define-key vhdl-template-map "fi" #'vhdl-template-file) + (define-key vhdl-template-map "fg" #'vhdl-template-for-generate) + (define-key vhdl-template-map "fl" #'vhdl-template-for-loop) + (define-key vhdl-template-map "\C-f" #'vhdl-template-footer) + (define-key vhdl-template-map "fb" #'vhdl-template-function-body) + (define-key vhdl-template-map "fd" #'vhdl-template-function-decl) + (define-key vhdl-template-map "ge" #'vhdl-template-generic) + (define-key vhdl-template-map "gd" #'vhdl-template-group-decl) + (define-key vhdl-template-map "gt" #'vhdl-template-group-template) + (define-key vhdl-template-map "\C-h" #'vhdl-template-header) + (define-key vhdl-template-map "ig" #'vhdl-template-if-generate) + (define-key vhdl-template-map "it" #'vhdl-template-if-then) + (define-key vhdl-template-map "li" #'vhdl-template-library) + (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop) + (define-key vhdl-template-map "\C-m" #'vhdl-template-modify) + (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date) + (define-key vhdl-template-map "ma" #'vhdl-template-map) + (define-key vhdl-template-map "ne" #'vhdl-template-next) + (define-key vhdl-template-map "ot" #'vhdl-template-others) + (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl) + (define-key vhdl-template-map "Pb" #'vhdl-template-package-body) + (define-key vhdl-template-map "(" #'vhdl-template-paired-parens) + (define-key vhdl-template-map "po" #'vhdl-template-port) + (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body) + (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl) + (define-key vhdl-template-map "pc" #'vhdl-template-process-comb) + (define-key vhdl-template-map "ps" #'vhdl-template-process-seq) + (define-key vhdl-template-map "rp" #'vhdl-template-report) + (define-key vhdl-template-map "rt" #'vhdl-template-return) + (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst) + (define-key vhdl-template-map "si" #'vhdl-template-signal) + (define-key vhdl-template-map "su" #'vhdl-template-subtype) + (define-key vhdl-template-map "ty" #'vhdl-template-type) + (define-key vhdl-template-map "us" #'vhdl-template-use) + (define-key vhdl-template-map "va" #'vhdl-template-variable) + (define-key vhdl-template-map "wa" #'vhdl-template-wait) + (define-key vhdl-template-map "wl" #'vhdl-template-while-loop) + (define-key vhdl-template-map "wi" #'vhdl-template-with) + (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait) + (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit) + (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std) + (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164) + (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith) + (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc) + (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed) + (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio) + (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned) + (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio) + (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on) + (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off) + (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on) + (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off) + (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt) (when (vhdl-standard-p 'ams) - (define-key vhdl-template-map "br" 'vhdl-template-break) - (define-key vhdl-template-map "cu" 'vhdl-template-case-use) - (define-key vhdl-template-map "iu" 'vhdl-template-if-use) - (define-key vhdl-template-map "lm" 'vhdl-template-limit) - (define-key vhdl-template-map "na" 'vhdl-template-nature) - (define-key vhdl-template-map "pa" 'vhdl-template-procedural) - (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) - (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) - (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) - (define-key vhdl-template-map "sn" 'vhdl-template-subnature) - (define-key vhdl-template-map "te" 'vhdl-template-terminal) + (define-key vhdl-template-map "br" #'vhdl-template-break) + (define-key vhdl-template-map "cu" #'vhdl-template-case-use) + (define-key vhdl-template-map "iu" #'vhdl-template-if-use) + (define-key vhdl-template-map "lm" #'vhdl-template-limit) + (define-key vhdl-template-map "na" #'vhdl-template-nature) + (define-key vhdl-template-map "pa" #'vhdl-template-procedural) + (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free) + (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch) + (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source) + (define-key vhdl-template-map "sn" #'vhdl-template-subnature) + (define-key vhdl-template-map "te" #'vhdl-template-terminal) ) (when (vhdl-standard-p 'math) - (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) - (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) + (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex) + (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real) )) ;; initialize template map for VHDL Mode @@ -2812,119 +2817,120 @@ STRING are replaced by `-' and substrings are converted to lower case." ;; model key bindings (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) ;; standard key bindings - (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) - (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) - (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) - (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) - (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) - (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) - (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) + (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement) + (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement) + (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp) + (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp) + (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list) + (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent) + (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent) (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs - (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) - (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) - (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) + (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun)) + (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp) + (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation) ;; mode specific key bindings - (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) - (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) - (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) - (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) - (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) - (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) - (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) - (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) - (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) - (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) - (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) - (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) - (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) - (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) - (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) - (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs - (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) - (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) - (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) - (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) - (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) - (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) - (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) - (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) - (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) - (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) - (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) - (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) - (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) - (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) - (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) - (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) - (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) - (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) - (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) - (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) - (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) - (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) - (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) - (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) - (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) - (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) - (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) - (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) - (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) - (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) - (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) - (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) - (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) - (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) - (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) - (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) - (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) - (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) - (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) - (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) - (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) - (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) - (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) - (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) - (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) - (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) - (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) - (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) - (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) - (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) - (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) - (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) - (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) - (define-key vhdl-mode-map "\M-\t" 'insert-tab) + (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode) + (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode) + (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project) + (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project) + (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project) + (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project) + (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler) + (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile) + (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make) + (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile) + (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity) + (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component) + (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance) + (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals) + (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants) + (define-key vhdl-mode-map + ;; `... C-g' not allowed in XEmacs. + (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g") + #'vhdl-port-paste-generic-map) + (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations) + (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench) + (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten) + (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction) + (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration) + (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body) + (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call) + (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten) + (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component) + (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component) + (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components) + (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration) + (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package) + (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region) + (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline) + (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line) + (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode) + (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group) + (define-key vhdl-mode-map "\M-\C-\\" #'indent-region) + (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent) + (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list) + (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations) + (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region) + (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group) + (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region) + (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group) + (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent) + (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region) + (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill) + (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy) + (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank) + (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand) + (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next) + (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous) + (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open) + (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line) + (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer) + (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause) + (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region) + (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer) + (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region) + (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer) + (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region) + (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer) + (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process) + (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer) + (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages) + (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode) + (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version) + (define-key vhdl-mode-map "\M-\t" #'insert-tab) ;; insert commands bindings - (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) - (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) - (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) - (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) + (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct) + (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package) + (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive) + (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert) ;; electric key bindings - (define-key vhdl-mode-map " " 'vhdl-electric-space) + (define-key vhdl-mode-map " " #'vhdl-electric-space) (when vhdl-intelligent-tab - (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) - (define-key vhdl-mode-map "\r" 'vhdl-electric-return) - (define-key vhdl-mode-map "-" 'vhdl-electric-dash) - (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) - (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) - (define-key vhdl-mode-map "'" 'vhdl-electric-quote) - (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) - (define-key vhdl-mode-map "," 'vhdl-electric-comma) - (define-key vhdl-mode-map "." 'vhdl-electric-period) + (define-key vhdl-mode-map "\t" #'vhdl-electric-tab)) + (define-key vhdl-mode-map "\r" #'vhdl-electric-return) + (define-key vhdl-mode-map "-" #'vhdl-electric-dash) + (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket) + (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket) + (define-key vhdl-mode-map "'" #'vhdl-electric-quote) + (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon) + (define-key vhdl-mode-map "," #'vhdl-electric-comma) + (define-key vhdl-mode-map "." #'vhdl-electric-period) (when (vhdl-standard-p 'ams) - (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) + (define-key vhdl-mode-map "=" #'vhdl-electric-equal))) ;; initialize mode map for VHDL Mode (vhdl-mode-map-init) @@ -2935,7 +2941,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (when vhdl-word-completion-in-minibuffer - (define-key map "\t" 'vhdl-minibuffer-tab)) + (define-key map "\t" #'vhdl-minibuffer-tab)) map) "Keymap for minibuffer used in VHDL Mode.") @@ -3168,7 +3174,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (unless (equal keyword "") (push (list keyword "" (vhdl-function-name - "vhdl-model" (nth 0 elem) "hook") 0 'system) + "vhdl-model" (nth 0 elem) "hook") + 0 'system) abbrev-list))) abbrev-list))))) @@ -3575,7 +3582,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ("Indent" ["Line" indent-according-to-mode :keys "C-c C-i C-l"] ["Group" vhdl-indent-group :keys "C-c C-i C-g"] - ["Region" vhdl-indent-region (mark)] + ["Region" indent-region (mark)] ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) ("Align" ["Group" vhdl-align-group t] @@ -4885,7 +4892,7 @@ Key bindings: (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) + (set (make-local-variable 'indent-line-function) #'vhdl-indent-line) (set (make-local-variable 'comment-start) "--") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-column) vhdl-inline-comment-column) @@ -4898,13 +4905,13 @@ Key bindings: ;; setup the comment indent variable in an Emacs version portable way ;; ignore any byte compiler warnings you might get here (when (boundp 'comment-indent-function) - (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) + (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent)) ;; initialize font locking (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line)) (if (eval-when-compile (fboundp 'syntax-propertize-rules)) (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-rules @@ -4913,7 +4920,7 @@ Key bindings: ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) (set (make-local-variable 'font-lock-syntactic-keywords) vhdl-font-lock-syntactic-keywords)) - (unless vhdl-emacs-21 + (when (featurep 'xemacs) (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) @@ -4959,10 +4966,10 @@ Key bindings: (defun vhdl-write-file-hooks-init () "Add/remove hooks when buffer is saved." (if vhdl-modify-date-on-saving - (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) - (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) + (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t) + (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t)) (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) - (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) + (add-hook 'after-save-hook #'vhdl-add-modified-file nil t)) (defun vhdl-process-command-line-option (option) "Process command line options for VHDL Mode." @@ -5745,7 +5752,7 @@ negative, skip forward otherwise." ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ (unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) - (defalias 'vhdl-forward-comment 'forward-comment)) + (defalias 'vhdl-forward-comment #'forward-comment)) (defun vhdl-back-to-indentation () "Move point to the first non-whitespace character on this line." @@ -5809,7 +5816,7 @@ negative, skip forward otherwise." state))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-in-literal 'vhdl-win-il)) + (fset 'vhdl-in-literal #'vhdl-win-il)) ;; Skipping of "syntactic whitespace". Syntactic whitespace is ;; defined as lexical whitespace or comments. Search no farther back @@ -5847,9 +5854,9 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) + (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws)) -(defun vhdl-beginning-of-macro (&optional lim) +(defun vhdl-beginning-of-macro (&optional _lim) "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5862,7 +5869,7 @@ negative, skip forward otherwise." (goto-char here) nil))) -(defun vhdl-beginning-of-directive (&optional lim) +(defun vhdl-beginning-of-directive (&optional _lim) "Go to the beginning of a directive (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5906,7 +5913,7 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) + (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws)) ;; Functions to help finding the correct indentation column: @@ -6054,7 +6061,7 @@ keyword." t) )) -(defun vhdl-corresponding-mid (&optional lim) +(defun vhdl-corresponding-mid (&optional _lim) (cond ((looking-at "is\\|block\\|generate\\|process\\|procedural") "begin") @@ -6270,7 +6277,7 @@ of an identifier that just happens to contain an \"end\" keyword." "A regular expression for searching backward that matches all known \"statement\" keywords.") -(defun vhdl-statement-p (&optional lim) +(defun vhdl-statement-p (&optional _lim) "Return t if we are looking at a real \"statement\" keyword. Assumes that the caller will make sure that we are looking at vhdl-statement-fwd-re, and are not inside a literal, and that we are not @@ -6462,7 +6469,7 @@ searches." ;; internal-p controls where the statement keyword can ;; be found. (internal-p (aref begin-vec 3)) - (last-backward (point)) last-forward + (last-backward (point)) ;; last-forward foundp literal keyword) ;; Look for the statement keyword. (while (and (not foundp) @@ -6497,7 +6504,7 @@ searches." (setq begin-re (concat "\\b\\(" begin-re "\\)\\b[^_]")) (save-excursion - (setq last-forward (point)) + ;; (setq last-forward (point)) ;; Look for the supplementary keyword ;; (bounded by the backward search start ;; point). @@ -6549,7 +6556,7 @@ With argument, do this that many times." (setq target (point))) (goto-char target))) -(defun vhdl-end-of-defun (&optional count) +(defun vhdl-end-of-defun (&optional _count) "Move forward to the end of a VHDL defun." (interactive) (let ((case-fold-search t)) @@ -7321,7 +7328,7 @@ after the containing paren which starts the arglist." (current-column)))) (- ce-curcol cs-curcol -1)))) -(defun vhdl-lineup-comment (langelem) +(defun vhdl-lineup-comment (_langelem) "Support old behavior for comment indentation. We look at vhdl-comment-only-line-offset to decide how to indent comment only-lines." @@ -7383,27 +7390,13 @@ only-lines." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Progress reporting -(defvar vhdl-progress-info nil - "Array variable for progress information: 0 begin, 1 end, 2 time.") - -(defun vhdl-update-progress-info (string pos) - "Update progress information." - (when (and vhdl-progress-info (not noninteractive) - (time-less-p vhdl-progress-interval - (time-since (aref vhdl-progress-info 2)))) - (let ((delta (- (aref vhdl-progress-info 1) - (aref vhdl-progress-info 0)))) - (message "%s... (%2d%%)" string - (if (= 0 delta) - 100 - (floor (* 100.0 (- pos (aref vhdl-progress-info 0))) - delta)))) - (aset vhdl-progress-info 2 (time-convert nil 'integer)))) +(defvar vhdl--progress-reporter nil + "Holds the progress reporter data during long running operations.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation commands -(defun vhdl-electric-tab (&optional prefix-arg) +(defun vhdl-electric-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else if right of non whitespace on line then insert tab, else if last command was a tab or return then dedent one step or if a comment @@ -7414,7 +7407,7 @@ else indent `correctly'." (cond ;; indent region if region is active ((and (not (featurep 'xemacs)) (use-region-p)) - (vhdl-indent-region (region-beginning) (region-end) nil)) + (indent-region (region-beginning) (region-end) nil)) ;; expand word ((= (char-syntax (preceding-char)) ?w) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) @@ -7423,12 +7416,12 @@ else indent `correctly'." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab ((> (current-column) (current-indentation)) (insert-tab)) @@ -7487,7 +7480,7 @@ indentation change." (setq syntax (vhdl-get-syntactic-context))))) (when is-comment (push (cons 'comment nil) syntax)) - (apply '+ (mapcar 'vhdl-get-offset syntax))) + (apply #'+ (mapcar #'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) (re-search-backward "^[^\n]" nil t) @@ -7509,25 +7502,17 @@ indentation change." (when (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) (run-hooks 'vhdl-special-indent-hook) - (vhdl-update-progress-info "Indenting" (vhdl-current-line)) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))) shift-amt)) -(defun vhdl-indent-region (beg end &optional column) - "Indent region as VHDL code. -Adds progress reporting to `indent-region'." - (interactive "r\nP") - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0))) - (indent-region beg end column) - (when vhdl-progress-interval (message "Indenting...done")) - (setq vhdl-progress-info nil)) +(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1") (defun vhdl-indent-buffer () "Indent whole buffer as VHDL code. Calls `indent-region' for whole buffer and adds progress reporting." (interactive) - (vhdl-indent-region (point-min) (point-max))) + (indent-region (point-min) (point-max))) (defun vhdl-indent-group () "Indent group of lines between empty lines." @@ -7540,7 +7525,7 @@ Calls `indent-region' for whole buffer and adds progress reporting." (if (re-search-forward vhdl-align-group-separate nil t) (point-marker) (point-max-marker))))) - (vhdl-indent-region beg end))) + (indent-region beg end))) (defun vhdl-indent-sexp (&optional endpos) "Indent each line of the list starting just after point. @@ -7699,7 +7684,7 @@ parentheses." ;; run FUNCTION (funcall function beg end spacing))) -(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) +(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent) "Attempt to align a range of lines based on the content of the lines. The definition of `alignment-list' determines the matching order and the manner in which the lines are aligned. If ALIGNMENT-LIST @@ -7709,12 +7694,15 @@ indentation is done before aligning." (setq alignment-list (or alignment-list vhdl-align-alist)) (setq spacing (or spacing 1)) (save-excursion - (let (bol indent) + (let (bol) ;; indent (goto-char end) (setq end (point-marker)) (goto-char begin) (setq bol (setq begin (progn (beginning-of-line) (point)))) - (when indent + ;; FIXME: The `indent' arg is not used, and I think it's because + ;; the let binding commented out above `indent' was hiding it, so + ;; the test below should maybe still test `indent'? + (when nil ;; indent (indent-region bol end nil)))) (let ((copy (copy-alist alignment-list))) (vhdl-prepare-search-2 @@ -7799,18 +7787,21 @@ the token in MATCH." "Align region, treat groups of lines separately." (interactive "r\nP") (save-excursion - (let (orig pos) - (goto-char beg) - (beginning-of-line) - (setq orig (point-marker)) - (setq beg (point)) - (goto-char end) - (setq end (point-marker)) - (untabify beg end) - (unless no-message - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0)))) + (goto-char beg) + (beginning-of-line) + (setq beg (point)) + (goto-char end) + (setq end (point-marker)) + (untabify beg end) + (let ((orig (copy-marker beg)) + pos + (vhdl--progress-reporter + (if no-message + ;; Preserve a potential progress reporter from + ;; when called from `vhdl-align-region' call. + vhdl--progress-reporter + (when vhdl-progress-interval + (make-progress-reporter "Aligning..." beg (copy-marker end)))))) (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (goto-char beg) @@ -7825,19 +7816,21 @@ the token in MATCH." (setq pos (point-marker)) (vhdl-align-region-1 beg pos spacing) (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) - (vhdl-update-progress-info "Aligning" (vhdl-current-line)) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))) (setq beg (1+ pos)) (goto-char beg)) ;; align last group (when (< beg end) (vhdl-align-region-1 beg end spacing) (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) - (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))))) (when vhdl-indent-tabs-mode (tabify orig end)) (unless no-message - (when vhdl-progress-interval (message "Aligning...done")) - (setq vhdl-progress-info nil))))) + (when vhdl--progress-reporter + (progress-reporter-done vhdl--progress-reporter)))))) (defun vhdl-align-region (beg end &optional spacing) "Align region, treat blocks with same indent and argument lists separately." @@ -7848,10 +7841,10 @@ the token in MATCH." ;; align blocks with same indent and argument lists (save-excursion (let ((cur-beg beg) - indent cur-end) - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0))) + indent cur-end + (vhdl--progress-reporter + (when vhdl-progress-interval + (make-progress-reporter "Aligning..." beg (copy-marker end))))) (goto-char end) (setq end (point-marker)) (goto-char cur-beg) @@ -7874,15 +7867,16 @@ the token in MATCH." (= (current-indentation) indent)) (<= (save-excursion (nth 0 (parse-partial-sexp - (point) (vhdl-point 'eol)))) 0)) + (point) (vhdl-point 'eol)))) + 0)) (unless (looking-at "^\\s-*$") (setq cur-end (vhdl-point 'bonl))) (beginning-of-line 2))) ;; align region (vhdl-align-region-groups cur-beg cur-end spacing t t)) (vhdl-align-inline-comment-region beg end spacing noninteractive) - (when vhdl-progress-interval (message "Aligning...done")) - (setq vhdl-progress-info nil))))) + (when vhdl--progress-reporter + (progress-reporter-done vhdl--progress-reporter)))))) (defun vhdl-align-group (&optional spacing) "Align group of lines between empty lines." @@ -8031,7 +8025,7 @@ empty lines are aligned individually, if `vhdl-align-groups' is non-nil." (tabify orig end)) (unless no-message (message "Aligning inline comments...done"))))) -(defun vhdl-align-inline-comment-group (&optional spacing) +(defun vhdl-align-inline-comment-group (&optional _spacing) "Align inline comments within a group of lines between empty lines." (interactive) (save-excursion @@ -8126,7 +8120,8 @@ end of line, do nothing in comments." "Convert all words matching WORD-REGEXP in region to lower or upper case, depending on parameter UPPER-CASE." (let ((case-replace nil) - (last-update 0)) + (pr (when (and count vhdl-progress-interval (not noninteractive)) + (make-progress-reporter "Fixing case..." beg (copy-marker end))))) (vhdl-prepare-search-2 (save-excursion (goto-char end) @@ -8137,19 +8132,13 @@ depending on parameter UPPER-CASE." (if upper-case (upcase-word -1) (downcase-word -1))) - (when (and count vhdl-progress-interval (not noninteractive) - (time-less-p vhdl-progress-interval - (time-since last-update))) - (message "Fixing case... (%2d%s)" - (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) - "%") - (setq last-update (time-convert nil 'integer)))) - (goto-char end))))) - -(defun vhdl-fix-case-region (beg end &optional arg) + (when pr (progress-reporter-update pr (point)))) + (when pr (progress-reporter-done pr)))))) + +(defun vhdl-fix-case-region (beg end &optional _arg) "Convert all VHDL words in region to lower or upper case, depending on options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") + (interactive "r") (vhdl-fix-case-region-1 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) (vhdl-fix-case-region-1 @@ -8195,11 +8184,11 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." ;; - force each statement to be on a separate line except when on same line ;; with 'end' keyword -(defun vhdl-fix-statement-region (beg end &optional arg) +(defun vhdl-fix-statement-region (beg end &optional _arg) "Force statements in region on separate line except when on same line with `end' keyword (necessary for correct indentation). Currently supported keywords: `begin', `if'." - (interactive "r\nP") + (interactive "r") (vhdl-prepare-search-2 (let (point) (save-excursion @@ -8251,9 +8240,9 @@ with `end' keyword (necessary for correct indentation)." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Trailing spaces -(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) +(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg) "Remove trailing spaces in region." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char end) (setq end (point-marker)) @@ -8283,7 +8272,7 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', (replace-match "" nil t))) (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) - (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) + (when (nth 2 vhdl-beautify-options) (indent-region beg end)) (when (nth 3 vhdl-beautify-options) (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) @@ -8516,7 +8505,7 @@ buffer." (delete-region sens-beg sens-end) (when read-list (insert " ()") (backward-char))) - (setq read-list (sort read-list 'string<)) + (setq read-list (sort read-list #'string<)) (when read-list (setq margin (current-column)) (insert (car read-list)) @@ -8548,7 +8537,7 @@ buffer." (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) "." (file-name-extension (buffer-file-name))))) (vhdl-visit-file - file-name t + file-name t (vhdl-prepare-search-2 (goto-char (point-min)) (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) @@ -8556,7 +8545,8 @@ buffer." (when (setq beg (vhdl-re-search-forward "\\<port[ \t\n\r\f]*(" (save-excursion - (re-search-forward "^end\\>" nil t)) t)) + (re-search-forward "^end\\>" nil t)) + t)) (setq end (save-excursion (backward-char) (forward-sexp) (point))) (vhdl-forward-syntactic-ws) @@ -8688,9 +8678,9 @@ buffer." Used for undoing after template abortion.") ;; correct different behavior of function `unread-command-events' in XEmacs -(defun vhdl-character-to-event (arg)) +(defun vhdl-character-to-event (_arg) nil) (defalias 'vhdl-character-to-event - (if (fboundp 'character-to-event) 'character-to-event 'identity)) + (if (fboundp 'character-to-event) #'character-to-event #'identity)) (defun vhdl-work-library () "Return the working library name of the current project or \"work\" if no @@ -9147,7 +9137,8 @@ a configuration declaration if not within a design unit." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "configuration" "(b)lock or (c)omponent configuration?" t) ?c) + "configuration" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) (t (vhdl-template-configuration-decl))))) ; otherwise @@ -9256,7 +9247,7 @@ a configuration declaration if not within a design unit." (interactive) (let ((margin (current-indentation)) (start (point)) - entity-exists string name position) + name position) ;; entity-exists string (vhdl-insert-keyword "CONTEXT ") (when (setq name (vhdl-template-field "name" nil t start (point))) (vhdl-insert-keyword " IS\n") @@ -9412,7 +9403,8 @@ otherwise." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "for" "(b)lock or (c)omponent configuration?" t) ?c) + "for" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) ((and (save-excursion @@ -9527,11 +9519,12 @@ otherwise." (defun vhdl-template-group () "Insert group or group template declaration." (interactive) - (let ((start (point))) - (if (eq (vhdl-decision-query - "group" "(d)eclaration or (t)emplate declaration?" t) ?t) - (vhdl-template-group-template) - (vhdl-template-group-decl)))) + ;; (let ((start (point))) + (if (eq (vhdl-decision-query + "group" "(d)eclaration or (t)emplate declaration?" t) + ?t) + (vhdl-template-group-template) + (vhdl-template-group-decl))) ;; ) (defun vhdl-template-group-decl () "Insert group declaration." @@ -10472,7 +10465,8 @@ specification, if not already there." (and (not (bobp)) (re-search-backward (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" - library "\\|end\\)\\>") nil t) + library "\\|end\\)\\>") + nil t) (match-string 2)))) (equal (downcase library) "work")) (vhdl-insert-keyword "LIBRARY ") @@ -10832,9 +10826,9 @@ If starting after end-comment-column, start a new line." (vhdl-line-kill-entire))))) (goto-char final-pos)))) -(defun vhdl-comment-uncomment-region (beg end &optional arg) +(defun vhdl-comment-uncomment-region (beg end &optional _arg) "Comment out region if not commented out, uncomment otherwise." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char (1- end)) (end-of-line) @@ -10911,7 +10905,7 @@ Point is left between them." "Read from user a procedure or function argument list." (insert " (") (let ((margin (current-column)) - (start (point)) + ;; (start (point)) (end-pos (point)) not-empty interface semicolon-pos) (unless vhdl-argument-list-indent @@ -10920,7 +10914,8 @@ Point is left between them." (indent-to margin)) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t)) + (unless is-function " | VARIABLE") "]") + " " t)) (while (vhdl-template-field "[names]" nil t) (setq not-empty t) (insert " : ") @@ -10937,7 +10932,8 @@ Point is left between them." (indent-to margin) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t))) + (unless is-function " | VARIABLE") "]") + " " t))) (delete-region end-pos (point)) (when semicolon-pos (goto-char semicolon-pos)) (if not-empty @@ -11157,7 +11153,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string." "Adjust case of following NUM words." (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) -(defun vhdl-minibuffer-tab (&optional prefix-arg) +(defun vhdl-minibuffer-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else insert tab (used for word completion in VHDL minibuffer)." (interactive "P") @@ -11170,12 +11166,12 @@ else insert tab (used for word completion in VHDL minibuffer)." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab (t (insert-tab)))) @@ -11562,7 +11558,8 @@ but not if inside a comment or quote." (unless (equal model-keyword "") (eval `(defun ,(vhdl-function-name - "vhdl-model" model-name "hook") () + "vhdl-model" model-name "hook") + () (vhdl-hooked-abbrev ',(vhdl-function-name "vhdl-model" model-name))))) (setq model-alist (cdr model-alist))))) @@ -11858,7 +11855,7 @@ reflected in a subsequent paste operation." (defun vhdl-port-paste-context-clause (&optional exclude-pack-name) "Paste a context clause." - (let ((margin (current-indentation)) + (let (;; (margin (current-indentation)) (clause-list (nth 3 vhdl-port-list)) clause) (while clause-list @@ -11868,7 +11865,8 @@ reflected in a subsequent paste operation." (save-excursion (re-search-backward (concat "^\\s-*use\\s-+" (car clause) - "." (cdr clause) "\\>") nil t))) + "." (cdr clause) "\\>") + nil t))) (vhdl-template-standard-package (car clause) (cdr clause)) (insert "\n")) (setq clause-list (cdr clause-list))))) @@ -12260,7 +12258,8 @@ reflected in a subsequent paste operation." (cond ((and vhdl-include-direction-comments (nth 2 port)) (format "%-6s" (concat "[" (nth 2 port) "] "))) (vhdl-include-direction-comments " ")) - (when vhdl-include-port-comments (nth 4 port))) t)) + (when vhdl-include-port-comments (nth 4 port))) + t)) (setq port-list (cdr port-list)) (when port-list (insert "\n") (indent-to margin))) ;; align signal list @@ -12314,7 +12313,7 @@ reflected in a subsequent paste operation." (let ((case-fold-search t) (ent-name (vhdl-replace-string vhdl-testbench-entity-name (nth 0 vhdl-port-list))) - (source-buffer (current-buffer)) + ;; (source-buffer (current-buffer)) arch-name config-name ent-file-name arch-file-name ent-buffer arch-buffer position) ;; open entity file @@ -12411,7 +12410,7 @@ reflected in a subsequent paste operation." (insert "\n") (setq position (point)) (vhdl-insert-string-or-file vhdl-testbench-declarations) - (vhdl-indent-region position (point))) + (indent-region position (point))) (setq position (point)) (insert "\n\n") (vhdl-comment-display-line) (insert "\n") @@ -12442,7 +12441,7 @@ reflected in a subsequent paste operation." (insert "\n") (setq position (point)) (vhdl-insert-string-or-file vhdl-testbench-statements) - (vhdl-indent-region position (point))) + (indent-region position (point))) (insert "\n") (indent-to vhdl-basic-offset) (unless (eq vhdl-testbench-create-files 'none) @@ -12815,7 +12814,7 @@ expressions (e.g. for index ranges of types and signals)." ;; override `he-list-beg' from `hippie-exp' (unless (and (boundp 'viper-mode) viper-mode) - (defalias 'he-list-beg 'vhdl-he-list-beg)) + (defalias 'he-list-beg #'vhdl-he-list-beg)) ;; function for expanding abbrevs and dabbrevs (defalias 'vhdl-expand-abbrev (make-hippie-expand-function @@ -12862,14 +12861,14 @@ expressions (e.g. for index ranges of types and signals)." (beginning-of-line) (yank)) -(defun vhdl-line-expand (&optional prefix-arg) +(defun vhdl-line-expand (&optional arg) "Hippie-expand current line." (interactive "P") (require 'hippie-exp) (let ((case-fold-search t) (case-replace nil) (hippie-expand-try-functions-list '(try-expand-line try-expand-line-all-buffers))) - (hippie-expand prefix-arg))) + (hippie-expand arg))) (defun vhdl-line-transpose-next (&optional arg) "Interchange this line with next line." @@ -12991,7 +12990,7 @@ File statistics: \"%s\"\n\ # total lines : %5d\n" (buffer-file-name) no-stats no-code-lines no-empty-lines no-comm-lines no-comments no-lines) - (unless vhdl-emacs-21 (vhdl-show-messages)))) + (when (featurep 'xemacs) (vhdl-show-messages)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Help functions @@ -13040,7 +13039,7 @@ File statistics: \"%s\"\n\ (customize-set-variable 'vhdl-project vhdl-project) (customize-save-customized)) -(defun vhdl-toggle-project (name token indent) +(defun vhdl-toggle-project (name _token _indent) "Set current project to NAME or unset if NAME is current project." (vhdl-set-project (if (equal name vhdl-project) "" name))) @@ -13244,6 +13243,7 @@ File statistics: \"%s\"\n\ "Toggle hideshow minor mode and update menu bar." (interactive "P") (require 'hideshow) + (declare-function hs-hide-all "hideshow" ()) ;; check for hideshow version 5.x (if (not (boundp 'hs-block-start-mdata-select)) (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") @@ -13255,8 +13255,8 @@ File statistics: \"%s\"\n\ hs-special-modes-alist))) (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) (if vhdl-hide-all-init - (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) - (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) + (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t) + (remove-hook 'hs-minor-mode-hook #'hs-hide-all t)) (hs-minor-mode arg) (force-mode-line-update))) ; hack to update menu bar @@ -13523,6 +13523,8 @@ This does background highlighting of translate-off regions.") (while syntax-alist (setq name (vhdl-function-name "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) + ;; FIXME: This `defvar' shouldn't be needed: just quote the face + ;; name when you use it. (eval `(defvar ,name ',name ,(concat "Face name to use for " (nth 0 (car syntax-alist)) "."))) @@ -13735,7 +13737,7 @@ This does background highlighting of translate-off regions.") (when (boundp 'ps-print-color-p) (vhdl-ps-print-settings)) (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) - (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) + (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -13907,7 +13909,7 @@ hierarchy otherwise.") pack-list pack-body-list inst-list inst-ent-list) ;; scan file (vhdl-visit-file - file-name nil + file-name nil (vhdl-prepare-search-2 (save-excursion ;; scan for design units @@ -14082,7 +14084,8 @@ hierarchy otherwise.") "component[ \t\n\r\f]+\\(\\w+\\)\\|" "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" - "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) + "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") + end-of-unit t) (or (not limit-hier-inst-no) (<= (if (or (match-string 14) (match-string 16)) @@ -14444,12 +14447,15 @@ of PROJECT." ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker ;; comp-lib-name level) -(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key - conf-inst-alist level indent - &optional include-top ent-hier) +(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key + conf-key-arg conf-inst-alist level indent + &optional include-top ent-hier) "Get instantiation hierarchy beginning in architecture ARCH-KEY of entity ENT-KEY." - (let* ((ent-entry (vhdl-aget ent-alist ent-key)) + (let* ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (conf-key conf-key-arg) + (ent-entry (vhdl-aget ent-alist ent-key)) (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) (cdar (last (nth 3 ent-entry))))) (inst-alist (nth 3 arch-entry)) @@ -14581,6 +14587,8 @@ entity ENT-KEY." (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") (sit-for 2))))) +(defvar vhdl-cache-version) + (defun vhdl-save-cache (key) "Save current hierarchy cache to file." (let* ((orig-buffer (current-buffer)) @@ -14667,7 +14675,7 @@ entity ENT-KEY." (file-dir-name (expand-file-name file-name directory)) vhdl-cache-version) (unless (memq 'vhdl-save-caches kill-emacs-hook) - (add-hook 'kill-emacs-hook 'vhdl-save-caches)) + (add-hook 'kill-emacs-hook #'vhdl-save-caches)) (when (file-exists-p file-dir-name) (condition-case () (progn (load-file file-dir-name) @@ -14707,6 +14715,8 @@ if required." (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) (declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(declare-function speedbar-expand-line "speedbar" (&optional arg)) +(declare-function speedbar-edit-line "speedbar" ()) (defun vhdl-speedbar-initialize () "Initialize speedbar." @@ -14731,19 +14741,19 @@ if required." ;; keymap (unless vhdl-speedbar-mode-map (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) + (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches) (let ((key 0)) (while (<= key 9) (define-key vhdl-speedbar-mode-map (int-to-string key) @@ -14814,7 +14824,7 @@ if required." (setq speedbar-initial-expansion-list-name "vhdl directory")) (when (eq vhdl-speedbar-display-mode 'project) (setq speedbar-initial-expansion-list-name "vhdl project")) - (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) + (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy))) (defun vhdl-speedbar (&optional arg) "Open/close speedbar." @@ -14832,17 +14842,17 @@ if required." "Name of last selected project.") ;; macros must be defined in the file they are used (copied from `speedbar.el') -;;; (defmacro speedbar-with-writable (&rest forms) -;;; "Allow the buffer to be writable and evaluate FORMS." -;;; (list 'let '((inhibit-read-only t)) -;;; (cons 'progn forms))) -;;; (put 'speedbar-with-writable 'lisp-indent-function 0) +;; (defmacro speedbar-with-writable (&rest forms) +;; "Allow the buffer to be writable and evaluate FORMS." +;; (declare (indent 0) (debug t)) +;; (list 'let '((inhibit-read-only t)) +;; (cons 'progn forms))) (declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) (declare-function speedbar-directory-buttons "speedbar" (directory _index)) (declare-function speedbar-file-lists "speedbar" (directory)) -(defun vhdl-speedbar-display-directory (directory depth &optional rescan) +(defun vhdl-speedbar-display-directory (directory depth &optional _rescan) "Display directory and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects nil) (setq speedbar-ignored-directory-regexp @@ -14863,7 +14873,7 @@ if required." (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) -(defun vhdl-speedbar-display-projects (project depth &optional rescan) +(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan) "Display projects and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects t) (setq speedbar-ignored-directory-regexp ".") @@ -14879,6 +14889,8 @@ if required." (declare-function speedbar-make-tag-line "speedbar" (type char func data tag tfunc tdata tface depth)) +(defvar vhdl-speedbar-update-current-unit) + (defun vhdl-speedbar-insert-projects () "Insert all projects in speedbar." (vhdl-speedbar-make-title-line "Projects:") @@ -14889,9 +14901,9 @@ if required." ;; insert projects (while project-alist (speedbar-make-tag-line - 'angle ?+ 'vhdl-speedbar-expand-project + 'angle ?+ #'vhdl-speedbar-expand-project (caar project-alist) (caar project-alist) - 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) + #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) (setq project-alist (cdr project-alist))) (setq project-alist vhdl-project-alist) ;; expand projects @@ -14938,12 +14950,14 @@ otherwise use cached data." (vhdl-speedbar-expand-units directory) (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) -(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist - ent-inst-list depth) +(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist + ent-inst-list depth) "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." (if (not (or ent-alist conf-alist pack-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) - (let (ent-entry conf-entry pack-entry) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + ent-entry conf-entry pack-entry) ;; insert entities (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) (while ent-alist @@ -15004,7 +15018,7 @@ otherwise use cached data." (declare-function speedbar-goto-this-file "speedbar" (file)) -(defun vhdl-speedbar-expand-dirs (directory) +(defun vhdl-speedbar-expand-dirs (_directory) "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." ;; (nicked from `speedbar-default-directory-list') @@ -15043,7 +15057,8 @@ otherwise use cached data." (goto-char position) (when (re-search-forward (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" - (car arch-alist) "\\>\\)") nil t) + (car arch-alist) "\\>\\)") + nil t) (beginning-of-line) (when (looking-at "^[0-9]+:\\s-*{") (goto-char (match-end 0)) @@ -15412,6 +15427,7 @@ otherwise use cached data." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Display help functions +;; FIXME: This `defvar' should be moved before its first use. (defvar vhdl-speedbar-update-current-unit t "Non-nil means to run `vhdl-speedbar-update-current-unit'.") @@ -15847,7 +15863,7 @@ NO-POSITION non-nil means do not re-position cursor." (abbreviate-file-name (file-name-as-directory (speedbar-line-directory indent))))) -(defun vhdl-speedbar-line-project (&optional indent) +(defun vhdl-speedbar-line-project (&optional _indent) "Get currently displayed project name." (and vhdl-speedbar-show-projects (save-excursion @@ -15917,7 +15933,7 @@ NO-POSITION non-nil means do not re-position cursor." ;; speedbar loads dframe at runtime. (declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) -(defun vhdl-speedbar-find-file (text token indent) +(defun vhdl-speedbar-find-file (_text token _indent) "When user clicks on TEXT, load file with name and position in TOKEN. Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file is already shown in a buffer." @@ -15945,12 +15961,12 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) - (end-of-line) - (if is-entity - (vhdl-port-copy) - (vhdl-subprog-copy))))) + (goto-char (point-min)) + (forward-line (1- (cdr token))) + (end-of-line) + (if is-entity + (vhdl-port-copy) + (vhdl-subprog-copy)))) (error (error "ERROR: %s not scanned successfully\n (%s)" (if is-entity "Port" "Interface") (cadr info)))) (error "ERROR: No entity/component or subprogram on current line"))))) @@ -16140,7 +16156,7 @@ expansion function)." ;; initialize speedbar (if (not (boundp 'speedbar-frame)) - (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)) + (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize)) (vhdl-speedbar-initialize) (when speedbar-frame (vhdl-speedbar-refresh))) @@ -16168,7 +16184,7 @@ expansion function)." (read-from-minibuffer "architecture name: " nil vhdl-minibuffer-local-map) (vhdl-replace-string vhdl-compose-architecture-name ent-name))) - ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) + ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project (message "Creating component \"%s(%s)\"..." ent-name arch-name) ;; open entity file (unless (eq vhdl-compose-create-files 'none) @@ -16368,7 +16384,7 @@ component instantiation." (if comp-name ;; ... from component declaration (vhdl-visit-file - (when vhdl-use-components-package pack-file-name) t + (when vhdl-use-components-package pack-file-name) t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) @@ -16379,7 +16395,7 @@ component instantiation." (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) "." (file-name-extension (buffer-file-name)))) (vhdl-visit-file - comp-ent-file-name t + comp-ent-file-name t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) @@ -16652,6 +16668,8 @@ component instantiation." (vhdl-comment-insert-inline (nth 4 entry) t)) (insert "\n")) +(defvar lazy-lock-minimum-size) + (defun vhdl-compose-components-package () "Generate a package containing component declarations for all entities in the current project/directory." @@ -16704,10 +16722,10 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) - (end-of-line) - (vhdl-port-copy))) + (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) + (end-of-line) + (vhdl-port-copy)) (goto-char component-pos) (vhdl-port-paste-component t) (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) @@ -16721,13 +16739,16 @@ current project/directory." (message "Generating components package \"%s\"...done\n File created: \"%s\"" pack-name pack-file-name))) -(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist - conf-alist inst-alist - &optional insert-conf) +(defun vhdl-compose-configuration-architecture ( _ent-name arch-name + ent-alist-arg conf-alist-arg + inst-alist + &optional insert-conf) "Generate block configuration for architecture." - (let ((margin (current-indentation)) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (margin (current-indentation)) (beg (point-at-bol)) - ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) + ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key ;; insert block configuration (for architecture) (vhdl-insert-keyword "FOR ") (insert arch-name "\n") (setq margin (+ margin vhdl-basic-offset)) @@ -17078,7 +17099,7 @@ do not print any file names." (file-relative-name (buffer-file-name)))) (when (and (= 0 (nth 1 (nth 10 compiler))) (= 0 (nth 1 (nth 11 compiler)))) - (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) + (setq compilation-process-setup-function #'vhdl-compile-print-file-name)) ;; run compilation (if options (when command @@ -17152,7 +17173,7 @@ specified by a target." vhdl-error-regexp-emacs-alist))) (when vhdl-emacs-22 - (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -17431,7 +17452,7 @@ specified by a target." (setq tmp-list rule-alist) (while tmp-list ; pre-sort rule targets (setq cell (cdar tmp-list)) - (setcar cell (sort (car cell) 'string<)) + (setcar cell (sort (car cell) #'string<)) (setq tmp-list (cdr tmp-list))) (setq rule-alist ; sort by first rule target (sort rule-alist @@ -17521,9 +17542,9 @@ specified by a target." ;; insert rule for each library unit (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") (while prim-list - (setq second-list (sort (nth 1 (car prim-list)) 'string<)) + (setq second-list (sort (nth 1 (car prim-list)) #'string<)) (setq subcomp-list - (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) + (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<)) (setq unit-key (caar prim-list) unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) (nth 0 (vhdl-aget conf-alist unit-key)) @@ -17553,7 +17574,7 @@ specified by a target." (vhdl-get-compile-options project compiler (nth 0 rule) t)) ;; insert rule if file is supposed to be compiled (setq target-list (nth 1 rule) - depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) + depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<)) ;; insert targets (setq tmp-list target-list) (while target-list @@ -17576,7 +17597,8 @@ specified by a target." (if (eq options 'default) "$(OPTIONS)" options) " " (nth 0 rule) (if (equal vhdl-compile-post-command "") "" - " $(POST-COMPILE)") "\n") + " $(POST-COMPILE)") + "\n") (insert "\n")) (unless (and options mapping-exist) (setq tmp-list target-list) @@ -17616,6 +17638,7 @@ specified by a target." "Submit via mail a bug report on VHDL Mode." (interactive) ;; load in reporter + (defvar reporter-prompt-for-summary-p) (and (y-or-n-p "Do you want to submit a report on VHDL Mode? ") (let ((reporter-prompt-for-summary-p t)) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 7bf2f71822a..72cbcf8bd68 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -1,4 +1,4 @@ -;;; ps-bdf.el --- BDF font file handler for ps-print +;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, @@ -138,7 +138,7 @@ See the documentation of the function `bdf-read-font-info' for more detail." (defun bdf-initialize () "Initialize `bdf' library." (and (bdf-read-cache) - (add-hook 'kill-emacs-hook 'bdf-write-cache))) + (add-hook 'kill-emacs-hook #'bdf-write-cache))) (defun bdf-compact-code (code code-range) (if (or (< code (aref code-range 4)) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index db86f9400e7..a8b5210e965 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1,4 +1,4 @@ -;;; ps-mule.el --- provide multi-byte character facility to ps-print +;;; ps-mule.el --- provide multi-byte character facility to ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively." (push (/ code 256) code-list) (push (% code 256) code-list)))) (forward-char 1))) - (apply 'unibyte-string (nreverse code-list)))) + (apply #'unibyte-string (nreverse code-list)))) (defun ps-mule-plot-composition (composition font-spec-table) "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE." @@ -1041,10 +1041,11 @@ Any other value is treated as \"/H0\"." (list (ps-mule-encode-region (point-min) (point-max) (aref ps-mule-font-spec-tables (aref ps-mule-font-number-to-type - (cond ((string= fonttag "/h0") 4) - ((string= fonttag "/h1") 5) - ((string= fonttag "/L0") 6) - (t 0)))))))) + (pcase fonttag + ("/h0" 4) + ("/h1" 5) + ("/L0" 6) + (_ 0)))))))) ;;;###autoload (defun ps-mule-begin-job (from to) @@ -1055,20 +1056,17 @@ It checks if all multi-byte characters in the region are printable or not." (goto-char from) (= (skip-chars-forward "\x00-\x7F" to) to))) ;; All characters can be printed by normal PostScript fonts. - (setq ps-basic-plot-string-function 'ps-basic-plot-string + (setq ps-basic-plot-string-function #'ps-basic-plot-string ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? - ps-encode-header-string-function 'identity) - (setq ps-basic-plot-string-function 'ps-mule-plot-string - ps-encode-header-string-function 'ps-mule-encode-header-string + ps-encode-header-string-function #'identity) + (setq ps-basic-plot-string-function #'ps-mule-plot-string + ps-encode-header-string-function #'ps-mule-encode-header-string ps-mule-font-info-database - (cond ((eq ps-multibyte-buffer 'non-latin-printer) - ps-mule-font-info-database-ps) - ((eq ps-multibyte-buffer 'bdf-font) - ps-mule-font-info-database-bdf) - ((eq ps-multibyte-buffer 'bdf-font-except-latin) - ps-mule-font-info-database-ps-bdf) - (t - ps-mule-font-info-database-default))) + (pcase ps-multibyte-buffer + ('non-latin-printer ps-mule-font-info-database-ps) + ('bdf-font ps-mule-font-info-database-bdf) + ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf) + (_ ps-mule-font-info-database-default))) ;; Be sure to have font information for Latin-1. (or (assq 'iso-8859-1 ps-mule-font-info-database) @@ -1112,10 +1110,12 @@ It checks if all multi-byte characters in the region are printable or not." id-max (1+ id-max)) (if (ps-mule-check-font font-spec) (aset font-spec-vec - (cond ((eq (car e) 'normal) 0) - ((eq (car e) 'bold) 1) - ((eq (car e) 'italic) 2) - (t 3)) font-spec))) + (pcase (car e) + ('normal 0) + ('bold 1) + ('italic 2) + (_ 3)) + font-spec))) (when (aref font-spec-vec 0) (or (aref font-spec-vec 3) (aset font-spec-vec 3 (or (aref font-spec-vec 1) @@ -1182,7 +1182,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (let ((output-head (list t)) (ps-mule-output-list (list t))) (dotimes (i 4) - (map-char-table 'ps-mule-prepare-glyph + (map-char-table #'ps-mule-prepare-glyph (aref ps-mule-font-spec-tables i))) (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head) (ps-output-prologue (cdr output-head))) diff --git a/lisp/rect.el b/lisp/rect.el index cb941b46009..504be41b673 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -652,7 +652,7 @@ with a prefix argument, prompt for START-AT and FORMAT." "Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated." - nil nil nil + :lighter nil (rectangle--reset-crutches) (when rectangle-mark-mode (add-hook 'deactivate-mark-hook diff --git a/lisp/repeat.el b/lisp/repeat.el index a2b04b81b03..f1b20d369bf 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -342,6 +342,29 @@ For example, you can set it to <return> like `isearch-exit'." :group 'convenience :version "28.1") +(defcustom repeat-keep-prefix t + "Keep the prefix arg of the previous command." + :type 'boolean + :group 'convenience + :version "28.1") + +(defcustom repeat-mode-echo #'repeat-mode-message + "Function to display a hint about available keys. +Function is called after every repeatable command with one argument: +a string with a list of keys." + :type '(choice (const :tag "Show hints in the echo area" + repeat-mode-message) + (const :tag "Don't show hints" ignore) + (function :tag "Function")) + :group 'convenience + :version "28.1") + +;;;###autoload +(defvar repeat-map nil + "The value of the repeating map for the next command. +A command called from the map can set it again to the same map when +the map can't be set on the command symbol property `repeat-map'.") + ;;;###autoload (define-minor-mode repeat-mode "Toggle Repeat mode. @@ -364,41 +387,50 @@ When Repeat mode is enabled, and the command symbol has the property named (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (when repeat-mode - (let ((repeat-map (and (symbolp this-command) - (get this-command 'repeat-map)))) - (when repeat-map - (when (boundp repeat-map) - (setq repeat-map (symbol-value repeat-map))) - (let ((map (copy-keymap repeat-map)) - keys mess) - (map-keymap (lambda (key _) (push key keys)) map) + (let ((rep-map (or repeat-map + (and (symbolp real-this-command) + (get real-this-command 'repeat-map))))) + (when rep-map + (when (boundp rep-map) + (setq rep-map (symbol-value rep-map))) + (let ((map (copy-keymap rep-map)) + keys) ;; Exit when the last char is not among repeatable keys, ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (or (memq last-command-event keys) - (memq this-original-command '(universal-argument - universal-argument-more - digit-argument - negative-argument))) + (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts + (or (lookup-key map (this-command-keys-vector)) + prefix-arg)) + ;; Messaging - (setq mess (format-message - "Repeat with %s%s" - (mapconcat (lambda (key) - (key-description (vector key))) - keys ", ") - (if repeat-exit-key - (format ", or exit with %s" - (key-description repeat-exit-key)) - ""))) - (if (current-message) - (message "%s [%s]" (current-message) mess) - (message mess)) + (unless prefix-arg + (map-keymap (lambda (key _) (push key keys)) map) + (let ((mess (format-message + "Repeat with %s%s" + (mapconcat (lambda (key) + (key-description (vector key))) + keys ", ") + (if repeat-exit-key + (format ", or exit with %s" + (key-description repeat-exit-key)) + "")))) + (funcall repeat-mode-echo mess))) ;; Adding an exit key (when repeat-exit-key (define-key map repeat-exit-key 'ignore)) - (set-transient-map map))))))) + (when (and repeat-keep-prefix (not prefix-arg)) + (setq prefix-arg current-prefix-arg)) + + (set-transient-map map)))))) + (setq repeat-map nil)) + +(defun repeat-mode-message (mess) + "Function that displays available repeating keys in the echo area." + (if (current-message) + (message "%s [%s]" (current-message) mess) + (message mess))) (provide 'repeat) diff --git a/lisp/replace.el b/lisp/replace.el index f131d263ec6..71c6e651c74 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1477,15 +1477,22 @@ If the value is nil, don't highlight the buffer names specially." (defcustom list-matching-lines-jump-to-current-line nil "If non-nil, \\[list-matching-lines] shows the current line highlighted. -Set the point right after such line when there are matches after it." +The current line for this purpose is the line of the original buffer +which was current when \\[list-matching-lines] was invoked. +Point in the `*Occur*' buffer will be set right after such line when +there are matches after it." :type 'boolean :group 'matching :version "26.1") (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. -If the face doesn't differ from the default face, -don't highlight the prefix with line numbers specially." +The prefix column is the part of display that precedes the actual +contents of the line; it normally shows the line number. \(For +multiline matches, the prefix column shows the line number for the +first line and whitespace for the rest of the lines.\) +If this face will display the same as the default face, the prefix +column will not be highlighted speciall." :type 'face :group 'matching :version "24.4") @@ -1565,11 +1572,24 @@ REGION must be a list of (START . END) positions as returned by `region-bounds'. The lines are shown in a buffer named `*Occur*'. -It serves as a menu to find any of the occurrences in this buffer. +That buffer can serve as a menu for finding any of the matches for REGEXP +in the current buffer. \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. -If `list-matching-lines-jump-to-current-line' is non-nil, then show -the current line highlighted with `list-matching-lines-current-line-face' -and set point at the first match after such line. + +Matches for REGEXP are shown in the face determined by the +variable `list-matching-lines-face'. +Names of buffers with matched lines are shown in the face determined +by the variable `list-matching-lines-buffer-name-face'. +The line numbers of the matching lines are shown in the face +determined by the variable `list-matching-lines-prefix-face'. + +If `list-matching-lines-jump-to-current-line' is non-nil, then the +line in the current buffer which was current when the command was +invoked will be shown in the `*Occur*' buffer highlighted with +the `list-matching-lines-current-line-face', with point at the end +of that line. (If the current line doesn't match REGEXP, it will +nonetheless be inserted into the `*Occur*' buffer between the 2 +closest lines that do match REGEXP.) If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 11226fda020..a0d4f6e96c2 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -568,8 +568,6 @@ format first." ;;;###autoload (define-minor-mode ruler-mode "Toggle display of ruler in header line (Ruler mode)." - nil nil - ruler-mode-map :group 'ruler-mode :variable (ruler-mode . (lambda (enable) diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index 8ba0cc9e032..415244f9e92 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -108,7 +108,7 @@ ARG is like in `end-of-buffer'." When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame." - nil " *SL*" nil + :lighter " *SL*" :global t :group 'windows (if scroll-all-mode diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index a03965cf6c7..f39f17329f2 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -1,4 +1,4 @@ -;;; shadowfile.el --- automatic file copying +;;; shadowfile.el --- automatic file copying -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -90,27 +90,23 @@ "If t, always copy shadow files without asking. If nil (the default), always ask. If not nil and not t, ask only if there is no buffer currently visiting the file." - :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)) - :group 'shadow) + :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))) (defcustom shadow-inhibit-message nil "If non-nil, do not display a message when a file needs copying." - :type 'boolean - :group 'shadow) + :type 'boolean) (defcustom shadow-inhibit-overload nil "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs]. Normally it overloads the function `save-buffers-kill-emacs' to check for files that have been changed and need to be copied to other systems." - :type 'boolean - :group 'shadow) + :type 'boolean) (defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows") "File to keep shadow information in. The `shadow-info-file' should be shadowed to all your accounts to ensure consistency. Default: ~/.emacs.d/shadows" :type 'file - :group 'shadow :version "26.2") (defcustom shadow-todo-file @@ -122,13 +118,12 @@ remember and ask you again in your next Emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.emacs.d/shadow_todo" :type 'file - :group 'shadow :version "26.2") -;;; The following two variables should in most cases initialize themselves -;;; correctly. They are provided as variables in case the defaults are wrong -;;; on your machine (and for efficiency). +;; The following two variables should in most cases initialize themselves +;; correctly. They are provided as variables in case the defaults are wrong +;; on your machine (and for efficiency). (defvar shadow-system-name (concat "/" (system-name) ":") "The identification for local files on this machine.") @@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.") (defvar shadow-files-to-copy nil) ; List of files that need to ; be copied to remote hosts. -(defvar shadow-hashtable nil) ; for speed +(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed (defvar shadow-info-buffer nil) ; buf visiting shadow-info-file (defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file @@ -191,11 +186,11 @@ PREFIX." ;;; Clusters and sites ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; I use the term `site' to refer to a string which may be the -;;; cluster identification "/name:", a remote identification -;;; "/method:user@host:", or "/system-name:" (the value of -;;; `shadow-system-name') for the location of local files. All -;;; user-level commands should accept either. +;; I use the term `site' to refer to a string which may be the +;; cluster identification "/name:", a remote identification +;; "/method:user@host:", or "/system-name:" (the value of +;; `shadow-system-name') for the location of local files. All +;; user-level commands should accept either. (cl-defstruct (shadow-cluster (:type list) :named) name primary regexp) @@ -580,7 +575,7 @@ be shadowed), and list of SITES." Filename should have clusters expanded, but otherwise can have any format. Return value is a list of dotted pairs like (from . to), where from and to are absolute file names." - (or (symbol-value (intern-soft file shadow-hashtable)) + (or (gethash file shadow-hashtable) (let* ((absolute-file (shadow-expand-file-name (or (shadow-local-file file) file) shadow-homedir)) @@ -598,7 +593,7 @@ and to are absolute file names." "shadow-shadows-of: %s %s %s %s %s" file (shadow-local-file file) shadow-homedir absolute-file canonical-file)) - (set (intern file shadow-hashtable) shadows)))) + (puthash file shadows shadow-hashtable)))) (defun shadow-shadows-of-1 (file groups regexp) "Return list of FILE's shadows in GROUPS. @@ -639,7 +634,7 @@ Consider them as regular expressions if third arg REGEXP is true." shadows shadow-files-to-copy (with-output-to-string (backtrace)))) (when shadows (setq shadow-files-to-copy - (cl-union shadows shadow-files-to-copy :test #'equal)) + (nreverse (cl-union shadows shadow-files-to-copy :test #'equal))) (when (not shadow-inhibit-message) (message "%s" (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) @@ -735,7 +730,7 @@ With non-nil argument also saves the buffer." (sit-for 1)))))) (defun shadow-invalidate-hashtable () - (setq shadow-hashtable (make-vector 37 0))) + (clrhash shadow-hashtable)) (defun shadow-insert-var (variable) "Build a `setq' to restore VARIABLE. @@ -744,17 +739,17 @@ will restore VARIABLE to its current setting. VARIABLE must be the name of a variable whose value is a list." (let ((standard-output (current-buffer))) (insert (format "(setq %s" variable)) - (cond ((consp (eval variable)) + (cond ((consp (symbol-value variable)) (insert "\n '(") - (prin1 (car (eval variable))) - (let ((rest (cdr (eval variable)))) + (prin1 (car (symbol-value variable))) + (let ((rest (cdr (symbol-value variable)))) (while rest (insert "\n ") (prin1 (car rest)) (setq rest (cdr rest))) (insert "))\n\n"))) (t (insert " ") - (prin1 (eval variable)) + (prin1 (symbol-value variable)) (insert ")\n\n"))))) (defun shadow-save-buffers-kill-emacs (&optional arg) @@ -763,6 +758,11 @@ With prefix arg, silently save all file-visiting buffers, then kill. Extended by shadowfile to automatically save `shadow-todo-file' and look for files that have been changed and need to be copied to other systems." + (interactive "P") + (shadow--save-buffers-kill-emacs arg) + (save-buffers-kill-emacs arg)) + +(defun shadow--save-buffers-kill-emacs (&optional arg &rest _) ;; This function is necessary because we need to get control and save ;; the todo file /after/ saving other files, but /before/ the warning ;; message about unsaved buffers (because it can get modified by the @@ -770,27 +770,10 @@ look for files that have been changed and need to be copied to other systems." ;; because it is not called at the correct time, and also because it is ;; called when the terminal is disconnected and we cannot ask whether ;; to copy files. - (interactive "P") (shadow-save-todo-file) (save-some-buffers arg t) (shadow-copy-files) - (shadow-save-todo-file) - (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf) - (buffer-modified-p buf))) - (buffer-list)))) - (yes-or-no-p "Modified buffers exist; exit anyway? ")) - (or (not (fboundp 'process-list)) - ;; `process-list' is not defined on MSDOS. - (let ((processes (process-list)) - active) - (while processes - (and (memq (process-status (car processes)) '(run stop open listen)) - (process-query-on-exit-flag (car processes)) - (setq active t)) - (setq processes (cdr processes))) - (or (not active) - (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) - (kill-emacs))) + (shadow-save-todo-file)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook us up @@ -809,19 +792,15 @@ look for files that have been changed and need to be copied to other systems." (message "Shadowfile information files not found - aborting") (beep) (sit-for 3)) - (when (and (not shadow-inhibit-overload) - (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) - (defalias 'shadow-orig-save-buffers-kill-emacs - (symbol-function 'save-buffers-kill-emacs)) - (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs)) - (add-hook 'write-file-functions 'shadow-add-to-todo) - (define-key ctl-x-4-map "s" 'shadow-copy-files))) + (unless shadow-inhibit-overload + (advice-add 'save-buffers-kill-emacs :before + #'shadow--save-buffers-kill-emacs)) + (add-hook 'write-file-functions #'shadow-add-to-todo) + (define-key ctl-x-4-map "s" #'shadow-copy-files))) (defun shadowfile-unload-function () - (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map) - (when (fboundp 'shadow-orig-save-buffers-kill-emacs) - (fset 'save-buffers-kill-emacs - (symbol-function 'shadow-orig-save-buffers-kill-emacs))) + (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map) + (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs) ;; continue standard unloading nil) @@ -832,7 +811,7 @@ look for files that have been changed and need to be copied to other systems." (defun shadow-union (a b) "Add members of list A to list B if not equal to items already in B." (declare (obsolete cl-union "28.1")) - (cl-union a b :test #'equal)) + (nreverse (cl-union a b :test #'equal))) (define-obsolete-function-alias 'shadow-find #'seq-find "28.1") diff --git a/lisp/shell.el b/lisp/shell.el index cd99b008776..3098d3a14da 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -980,7 +980,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." The `dirtrack' package provides an alternative implementation of this feature; see the function `dirtrack-mode'." - nil nil nil + :lighter nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) diff --git a/lisp/simple.el b/lisp/simple.el index c48e644345b..999755a642f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2798,7 +2798,6 @@ or to the last history element for a backward search." (if isearch-forward (goto-history-element (length (minibuffer-history-value))) (goto-history-element 0)) - (setq isearch-success t) (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max)))) (defun minibuffer-history-isearch-push-state () diff --git a/lisp/so-long.el b/lisp/so-long.el index f44d41dc5eb..f916b61b60f 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -1185,7 +1185,7 @@ current buffer, and buffer-local values are assigned to variables in accordance with `so-long-variable-overrides'. This minor mode is a standard `so-long-action' option." - nil nil nil + :lighter nil (if so-long-minor-mode ;; We are enabling the mode. (progn ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather diff --git a/lisp/startup.el b/lisp/startup.el index 3e39ebc6e22..6e0faf3f68a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1111,7 +1111,7 @@ please check its value") ("--no-x-resources") ("--debug-init") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") - ("--dump-file") ("--temacs"))) + ("--dump-file") ("--temacs") ("--seccomp"))) (argi (pop args)) (orig-argi argi) argval) @@ -1163,7 +1163,8 @@ please check its value") (push '(visibility . icon) initial-frame-alist)) ((member argi '("-nbc" "-no-blinking-cursor")) (setq no-blinking-cursor t)) - ((member argi '("-dump-file" "-temacs")) ; Handled in C + ((member argi '("-dump-file" "-temacs" "-seccomp")) + ;; Handled in C (or argval (pop args)) (setq argval nil)) ;; Push the popped arg back on the list of arguments. diff --git a/lisp/strokes.el b/lisp/strokes.el index 4b682e99feb..575092a71d9 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1393,7 +1393,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\[strokes-decode-buffer]. \\{strokes-mode-map}" - nil strokes-lighter strokes-mode-map :global t + :lighter strokes-lighter :global t (cond ((not (display-mouse-p)) (error "Can't use Strokes without a mouse")) (strokes-mode ; turn on strokes diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2e27b293c5e..f3c2fb7ed96 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2075,6 +2075,28 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab) (define-key tab-prefix-map "t" 'other-tab-prefix) +(defvar tab-bar-switch-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "o" 'tab-next) + (define-key map "O" 'tab-previous) + map) + "Keymap to repeat tab switch key sequences `C-x t o o O'. +Used in `repeat-mode'.") +(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) +(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) + +(defvar tab-bar-move-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "m" 'tab-move) + (define-key map "M" (lambda () + (interactive) + (setq repeat-map 'tab-bar-move-repeat-map) + (tab-move -1))) + map) + "Keymap to repeat tab move key sequences `C-x t m m M'. +Used in `repeat-mode'.") +(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) + (provide 'tab-bar) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index fa9b47556f7..3f0cca0ab7a 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -474,6 +474,7 @@ checksum before doing the check." "Construct a `rw-r--r--' string indicating MODE. MODE should be an integer which is a file mode value. For instance, if mode is #o700, then it produces `rwx------'." + (declare (obsolete file-modes-number-to-symbolic "28.1")) (substring (file-modes-number-to-symbolic mode) 1)) (defun tar-header-block-summarize (tar-hblock &optional mod-p) @@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces `rwx------'." ;; (ck (tar-header-checksum tar-hblock)) (type (tar-header-link-type tar-hblock)) (link-name (tar-header-link-name tar-hblock))) - (format "%c%c%s %7s/%-7s %7s%s %s%s" + (format "%c%s %7s/%-7s %7s%s %s%s" (if mod-p ?* ? ) - (cond ((or (eq type nil) (eq type 0)) ?-) - ((eq type 1) ?h) ; link - ((eq type 2) ?l) ; symlink - ((eq type 3) ?c) ; char special - ((eq type 4) ?b) ; block special - ((eq type 5) ?d) ; directory - ((eq type 6) ?p) ; FIFO/pipe - ((eq type 20) ?*) ; directory listing - ((eq type 28) ?L) ; next has longname - ((eq type 29) ?M) ; multivolume continuation - ((eq type 35) ?S) ; sparse - ((eq type 38) ?V) ; volume header - ((eq type 55) ?H) ; pax global extended header - ((eq type 72) ?X) ; pax extended header - (t ?\s) - ) - (tar-grind-file-mode mode) + (file-modes-number-to-symbolic + mode + (cond ((or (eq type nil) (eq type 0)) ?-) + ((eq type 1) ?h) ; link + ((eq type 2) ?l) ; symlink + ((eq type 3) ?c) ; char special + ((eq type 4) ?b) ; block special + ((eq type 5) ?d) ; directory + ((eq type 6) ?p) ; FIFO/pipe + ((eq type 20) ?*) ; directory listing + ((eq type 28) ?L) ; next has longname + ((eq type 29) ?M) ; multivolume continuation + ((eq type 35) ?S) ; sparse + ((eq type 38) ?V) ; volume header + ((eq type 55) ?H) ; pax global extended header + ((eq type 72) ?X) ; pax extended header + (t ?\s) + )) (if (= 0 (length uname)) uid uname) (if (= 0 (length gname)) gid gname) size @@ -751,7 +753,7 @@ into the tar-file buffer that it came from. The changes will actually appear on disk when you save the tar-file's buffer." ;; Don't do this, because it is redundant and wastes mode line space. ;; :lighter " TarFile" - nil nil nil + :lighter nil (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) (error "This buffer is not an element of a tar file")) (cond (tar-subfile-mode diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index eb521134dc4..932308ee59d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3744,7 +3744,7 @@ SPC. For spell-checking \"on the fly\", not just after typing SPC or RET, use `flyspell-mode'." - nil " Spell" ispell-minor-keymap) + :lighter " Spell" :keymap ispell-minor-keymap) (defun ispell-minor-check () "Check previous word, then continue with the normal binding of this key. diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 53519ac3386..e710180d5f5 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -245,10 +245,10 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (forward-paragraph 1) (setq end (point)) (setq found - (refer-every (lambda (keyword) - (goto-char begin) - (re-search-forward keyword end t)) - keywords-list)) + (seq-every-p (lambda (keyword) + (goto-char begin) + (re-search-forward keyword end t)) + keywords-list)) (if (not found) (progn (setq begin end) @@ -260,12 +260,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (progn (message "Scanning %s... not found" file) nil)))) -(defun refer-every (pred l) - (cond ((null l) nil) - ((funcall pred (car l)) - (or (null (cdr l)) - (refer-every pred (cdr l)))))) - (defun refer-convert-string-to-list-of-strings (s) (let ((current (current-buffer)) (temp-buffer (get-buffer-create "*refer-temp*"))) @@ -391,4 +385,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (setq refer-bib-files files)) files)) +(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1") + ;;; refer.el ends here diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index cd76bf80f19..8a0436afc64 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -607,7 +607,7 @@ This sets `buffer-save-without-query' so that `save-some-buffers' will save the notes buffer without asking. \\{remember-notes-mode-map}" - nil nil nil + :lighter nil (cond (remember-notes-mode (add-hook 'kill-buffer-query-functions diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 56cca840047..1471be0ecd6 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1408,13 +1408,11 @@ highlighting. When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this for modes derived from Text mode, like Mail mode." - ;; The initial value. - nil - ;; The indicator for the mode line. - " ReST" - ;; The minor mode bindings. - rst-mode-map - :group 'rst) + ;; The indicator for the mode line. + :lighter " ReST" + ;; The minor mode bindings. + :keymap rst-mode-map + :group 'rst) ;; FIXME: can I somehow install these too? ;; :abbrev-table rst-mode-abbrev-table diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 6958ab8f658..67f731917e2 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -2440,7 +2440,7 @@ The third `match-string' will be the used in the menu.") HTML Autoview mode is a buffer-local minor mode for use with `html-mode'. If enabled, saving the file automatically runs `browse-url-of-buffer' to view it." - nil nil nil + :lighter nil (if html-autoview-mode (add-hook 'after-save-hook #'browse-url-of-buffer nil t) (remove-hook 'after-save-hook #'browse-url-of-buffer t))) diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 069c8e3f443..163978b4315 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -486,7 +486,7 @@ that space character is replaced by a hard space specified by When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space representation for current major mode, the `tildify-space-string' buffer-local variable will be set to the representation." - nil " ~" nil + :lighter " ~" (when tildify-mode (let ((space (with-suppressed-warnings ((obsolete tildify--pick-alist-entry)) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 56b31662210..eabbaba32c0 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -191,7 +191,8 @@ when this variable is set to nil.") (defconst log-edit-files-buf "*log-edit-files*") (defvar log-edit-initial-files nil) (defvar log-edit-callback nil) -(defvar log-edit-diff-function nil) +(defvar log-edit-diff-function + (lambda () (error "Diff functionality has not been setup"))) (defvar log-edit-listfun nil) (defvar log-edit-parent-buffer nil) @@ -659,9 +660,7 @@ Also saves its contents in the comment history and hides (defun log-edit-show-diff () "Show the diff for the files to be committed." (interactive) - (if (functionp log-edit-diff-function) - (funcall log-edit-diff-function) - (error "Diff functionality has not been setup"))) + (funcall log-edit-diff-function)) (defun log-edit-show-files () "Show the list of files to be committed." diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 6e039cc6256..42f531e4f75 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -331,7 +331,7 @@ the primary since reading the primary can deactivate it." "This mode is used for buffers related to a main *cvs* buffer. All the `cvs-mode' buffer operations are simply rebound under the \\[cvs-mode-map] prefix." - nil " CVS" + :lighter " CVS" :group 'pcl-cvs) (put 'cvs-minor-mode 'permanent-local t) diff --git a/lisp/vt-control.el b/lisp/vt-control.el index 0bd5132f7c3..bac0069b852 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -83,26 +83,24 @@ (defun vt-keypad-on (&optional tell) "Turn on the VT applications keypad." - (interactive) + (interactive "p") (send-string-to-terminal "\e=") (setq vt-applications-keypad-p t) - (if (or tell (called-interactively-p 'interactive)) - (message "Applications keypad enabled."))) + (if tell (message "Applications keypad enabled."))) (defun vt-keypad-off (&optional tell) "Turn off the VT applications keypad." (interactive "p") (send-string-to-terminal "\e>") (setq vt-applications-keypad-p nil) - (if (or tell (called-interactively-p 'interactive)) - (message "Applications keypad disabled."))) + (if tell (message "Applications keypad disabled."))) -(defun vt-numlock nil +(defun vt-numlock (&optional tell) "Toggle VT application keypad on and off." - (interactive) + (interactive "p") (if vt-applications-keypad-p - (vt-keypad-off (called-interactively-p 'interactive)) - (vt-keypad-on (called-interactively-p 'interactive)))) + (vt-keypad-off tell) + (vt-keypad-on tell))) (provide 'vt-control) diff --git a/lisp/window.el b/lisp/window.el index f27631bb86a..071761ea50f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10256,6 +10256,10 @@ displaying that processes's buffer." (defvar other-window-repeat-map (let ((map (make-sparse-keymap))) (define-key map "o" 'other-window) + (define-key map "O" (lambda () + (interactive) + (setq repeat-map 'other-window-repeat-map) + (other-window -1))) map) "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") (put 'other-window 'repeat-map 'other-window-repeat-map) diff --git a/lisp/winner.el b/lisp/winner.el index 9506ac53bb2..f30fa6cf5cf 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,4 +1,4 @@ -;;; winner.el --- Restore old window configurations +;;; winner.el --- Restore old window configurations -*- lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. @@ -33,14 +33,13 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'ring) (defun winner-active-region () (declare (gv-setter (lambda (store) `(if ,store (activate-mark) (deactivate-mark))))) (region-active-p)) -(require 'ring) - (defgroup winner nil "Restoring window configurations." :group 'windows) @@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*, *Apropos*, (let* ((buffers nil) (alive ;; Possibly update `winner-point-alist' - (cl-loop for buf in (mapcar 'cdr (cdr conf)) + (cl-loop for buf in (mapcar #'cdr (cdr conf)) for pos = (winner-get-point buf nil) if (and pos (not (memq buf buffers))) do (push buf buffers) @@ -317,7 +316,7 @@ You may want to include buffer names such as *Help*, *Apropos*, ;; Return t if this is still a possible configuration. (or (null xwins) (progn - (mapc 'delete-window (cdr xwins)) ; delete all but one + (mapc #'delete-window (cdr xwins)) ; delete all but one (unless (one-window-p t) (delete-window (car xwins)) t)))))) @@ -328,22 +327,20 @@ You may want to include buffer names such as *Help*, *Apropos*, (defcustom winner-mode-hook nil "Functions to run whenever Winner mode is turned on or off." - :type 'hook - :group 'winner) + :type 'hook) (define-obsolete-variable-alias 'winner-mode-leave-hook 'winner-mode-off-hook "24.3") (defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." - :type 'hook - :group 'winner) + :type 'hook) (defvar winner-mode-map (let ((map (make-sparse-keymap))) (unless winner-dont-bind-my-keys - (define-key map [(control c) left] 'winner-undo) - (define-key map [(control c) right] 'winner-redo)) + (define-key map [(control c) left] #'winner-undo) + (define-key map [(control c) right] #'winner-redo)) map) "Keymap for Winner mode.") diff --git a/src/emacs.c b/src/emacs.c index d353679b0f0..e5940ce1de6 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -62,6 +62,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # include <sys/socket.h> #endif +#if defined HAVE_LINUX_SECCOMP_H && defined HAVE_LINUX_FILTER_H \ + && HAVE_DECL_SECCOMP_SET_MODE_FILTER \ + && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC +# define SECCOMP_USABLE 1 +#else +# define SECCOMP_USABLE 0 +#endif + +#if SECCOMP_USABLE +# include <linux/seccomp.h> +# include <linux/filter.h> +# include <sys/prctl.h> +# include <sys/syscall.h> +#endif + #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ @@ -242,6 +257,11 @@ Initialization options:\n\ --dump-file FILE read dumped state from FILE\n\ ", #endif +#if SECCOMP_USABLE + "\ +--sandbox=FILE read Seccomp BPF filter from FILE\n\ +" +#endif "\ --no-build-details do not add build details such as time stamps\n\ --no-desktop do not load a saved desktop\n\ @@ -977,12 +997,195 @@ load_pdump (int argc, char **argv, char const *original_pwd) } #endif /* HAVE_PDUMPER */ +#if SECCOMP_USABLE + +/* Wrapper function for the `seccomp' system call on GNU/Linux. This + system call usually doesn't have a wrapper function. See the + manual page of `seccomp' for the signature. */ + +static int +emacs_seccomp (unsigned int operation, unsigned int flags, void *args) +{ +#ifdef SYS_seccomp + return syscall (SYS_seccomp, operation, flags, args); +#else + errno = ENOSYS; + return -1; +#endif +} + +/* Read SIZE bytes into BUFFER. Return the number of bytes read, or + -1 if reading failed altogether. */ + +static ptrdiff_t +read_full (int fd, void *buffer, ptrdiff_t size) +{ + eassert (0 <= fd); + eassert (buffer != NULL); + eassert (0 <= size); + enum + { + /* See MAX_RW_COUNT in sysdep.c. */ +#ifdef MAX_RW_COUNT + max_size = MAX_RW_COUNT +#else + max_size = INT_MAX >> 18 << 18 +#endif + }; + if (PTRDIFF_MAX < size || max_size < size) + { + errno = EFBIG; + return -1; + } + char *ptr = buffer; + ptrdiff_t read = 0; + while (size != 0) + { + ptrdiff_t n = emacs_read (fd, ptr, size); + if (n < 0) + return -1; + if (n == 0) + break; /* Avoid infinite loop on encountering EOF. */ + eassert (n <= size); + size -= n; + ptr += n; + read += n; + } + return read; +} + +/* Attempt to load Secure Computing filters from FILE. Return false + if that doesn't work for some reason. */ + +static bool +load_seccomp (const char *file) +{ + bool success = false; + void *buffer = NULL; + int fd + = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0); + if (fd < 0) + { + emacs_perror ("open"); + goto out; + } + struct stat stat; + if (fstat (fd, &stat) != 0) + { + emacs_perror ("fstat"); + goto out; + } + if (! S_ISREG (stat.st_mode)) + { + fprintf (stderr, "seccomp file %s is not regular\n", file); + goto out; + } + struct sock_fprog program; + if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size + || PTRDIFF_MAX <= stat.st_size + || stat.st_size % sizeof *program.filter != 0) + { + fprintf (stderr, "seccomp filter %s has invalid size %ld\n", + file, (long) stat.st_size); + goto out; + } + size_t size = stat.st_size; + size_t count = size / sizeof *program.filter; + eassert (0 < count && count < SIZE_MAX); + if (USHRT_MAX < count) + { + fprintf (stderr, "seccomp filter %s is too big\n", file); + goto out; + } + /* Try reading one more byte to detect file size changes. */ + buffer = malloc (size + 1); + if (buffer == NULL) + { + emacs_perror ("malloc"); + goto out; + } + ptrdiff_t read = read_full (fd, buffer, size + 1); + if (read < 0) + { + emacs_perror ("read"); + goto out; + } + eassert (read <= SIZE_MAX); + if (read != size) + { + fprintf (stderr, + "seccomp filter %s changed size while reading\n", + file); + goto out; + } + if (emacs_close (fd) != 0) + emacs_perror ("close"); /* not a fatal error */ + fd = -1; + program.len = count; + program.filter = buffer; + + /* See man page of `seccomp' why this is necessary. Note that we + intentionally don't check the return value: a parent process + might have made this call before, in which case it would fail; + or, if enabling privilege-restricting mode fails, the `seccomp' + syscall will fail anyway. */ + prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0); + /* Install the filter. Make sure that potential other threads can't + escape it. */ + if (emacs_seccomp (SECCOMP_SET_MODE_FILTER, + SECCOMP_FILTER_FLAG_TSYNC, &program) + != 0) + { + emacs_perror ("seccomp"); + goto out; + } + success = true; + + out: + if (0 <= fd) + emacs_close (fd); + free (buffer); + return success; +} + +/* Load Secure Computing filter from file specified with the --seccomp + option. Exit if that fails. */ + +static void +maybe_load_seccomp (int argc, char **argv) +{ + int skip_args = 0; + char *file = NULL; + while (skip_args < argc - 1) + { + if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file, + &skip_args) + || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args)) + break; + ++skip_args; + } + if (file == NULL) + return; + if (! load_seccomp (file)) + fatal ("cannot enable seccomp filter from %s", file); +} + +#endif /* SECCOMP_USABLE */ + int main (int argc, char **argv) { /* Variable near the bottom of the stack, and aligned appropriately for pointers. */ void *stack_bottom_variable; + + /* First, check whether we should apply a seccomp filter. This + should come at the very beginning to allow the filter to protect + the initialization phase. */ +#if SECCOMP_USABLE + maybe_load_seccomp (argc, argv); +#endif + bool no_loadup = false; char *junk = 0; char *dname_arg = 0; @@ -2179,12 +2382,15 @@ static const struct standard_args standard_args[] = { "-color", "--color", 5, 0}, { "-no-splash", "--no-splash", 3, 0 }, { "-no-desktop", "--no-desktop", 3, 0 }, - /* The following two must be just above the file-name args, to get + /* The following three must be just above the file-name args, to get them out of our way, but without mixing them with file names. */ { "-temacs", "--temacs", 1, 1 }, #ifdef HAVE_PDUMPER { "-dump-file", "--dump-file", 1, 1 }, #endif +#if SECCOMP_USABLE + { "-seccomp", "--seccomp", 1, 1 }, +#endif #ifdef HAVE_NS { "-NSAutoLaunch", 0, 5, 1 }, { "-NXAutoLaunch", 0, 5, 1 }, diff --git a/src/xdisp.c b/src/xdisp.c index a405d51f803..50d9040057a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13607,8 +13607,9 @@ redisplay_tab_bar (struct frame *f) /* Get information about the tab-bar item which is displayed in GLYPH on frame F. Return in *PROP_IDX the index where tab-bar item - properties start in F->tab_bar_items. Value is false if - GLYPH doesn't display a tab-bar item. */ + properties start in F->tab_bar_items. Return in CLOSE_P an + indication whether the click was on the close-tab icon of the tab. + Value is false if GLYPH doesn't display a tab-bar item. */ static bool tab_bar_item_info (struct frame *f, struct glyph *glyph, @@ -13654,7 +13655,6 @@ static int get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, int *hpos, int *vpos, int *prop_idx, bool *close_p) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tab_bar_window); int area; @@ -13668,18 +13668,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, if (!tab_bar_item_info (f, *glyph, prop_idx, close_p)) return -1; - /* Is mouse on the highlighted item? */ - if (EQ (f->tab_bar_window, hlinfo->mouse_face_window) - && *vpos >= hlinfo->mouse_face_beg_row - && *vpos <= hlinfo->mouse_face_end_row - && (*vpos > hlinfo->mouse_face_beg_row - || *hpos >= hlinfo->mouse_face_beg_col) - && (*vpos < hlinfo->mouse_face_end_row - || *hpos < hlinfo->mouse_face_end_col - || hlinfo->mouse_face_past_end)) - return 0; - - return 1; + return *prop_idx == f->last_tab_bar_item ? 0 : 1; } @@ -13693,7 +13682,6 @@ void handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, int modifiers) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tab_bar_window); int hpos, vpos, prop_idx; bool close_p; @@ -13701,47 +13689,27 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, Lisp_Object enabled_p; int ts; - /* If not on the highlighted tab-bar item, and mouse-highlight is - non-nil, return. This is so we generate the tab-bar button - click only when the mouse button is released on the same item as - where it was pressed. However, when mouse-highlight is disabled, - generate the click when the button is released regardless of the - highlight, since tab-bar items are not highlighted in that - case. */ frame_to_window_pixel_xy (w, &x, &y); ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); if (ts == -1 - || (ts != 0 && !NILP (Vmouse_highlight))) + /* If the button is released on a tab other than the one where + it was pressed, don't generate the tab-bar button click event. */ + || (ts != 0 && !down_p)) return; - /* When mouse-highlight is off, generate the click for the item - where the button was pressed, disregarding where it was - released. */ - if (NILP (Vmouse_highlight) && !down_p) - prop_idx = f->last_tab_bar_item; - /* If item is disabled, do nothing. */ enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); if (NILP (enabled_p)) return; if (down_p) - { - /* Show item in pressed state. */ - if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); - f->last_tab_bar_item = prop_idx; - } + f->last_tab_bar_item = prop_idx; /* record the pressed tab */ else { Lisp_Object key, frame; struct input_event event; EVENT_INIT (event); - /* Show item in released state. */ - if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); - key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY); XSETFRAME (frame, f); @@ -13754,97 +13722,6 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, } } - -/* Possibly highlight a tab-bar item on frame F when mouse moves to - tab-bar window-relative coordinates X/Y. Called from - note_mouse_highlight. */ - -static void -note_tab_bar_highlight (struct frame *f, int x, int y) -{ - Lisp_Object window = f->tab_bar_window; - struct window *w = XWINDOW (window); - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - int hpos, vpos; - struct glyph *glyph; - struct glyph_row *row; - int i; - Lisp_Object enabled_p; - int prop_idx; - bool close_p; - enum draw_glyphs_face draw = DRAW_IMAGE_RAISED; - int rc; - - /* Function note_mouse_highlight is called with negative X/Y - values when mouse moves outside of the frame. */ - if (x <= 0 || y <= 0) - { - clear_mouse_face (hlinfo); - return; - } - - rc = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); - if (rc < 0) - { - /* Not on tab-bar item. */ - clear_mouse_face (hlinfo); - return; - } - else if (rc == 0) - /* On same tab-bar item as before. */ - goto set_help_echo; - - clear_mouse_face (hlinfo); - - bool mouse_down_p = false; -#ifndef HAVE_NS - /* Mouse is down, but on different tab-bar item? */ - Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); - mouse_down_p = (gui_mouse_grabbed (dpyinfo) - && f == dpyinfo->last_mouse_frame); - - if (mouse_down_p && f->last_tab_bar_item != prop_idx) - return; -#endif - draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; - - /* If tab-bar item is not enabled, don't highlight it. */ - enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); - if (!NILP (enabled_p) && !NILP (Vmouse_highlight)) - { - /* Compute the x-position of the glyph. In front and past the - image is a space. We include this in the highlighted area. */ - row = MATRIX_ROW (w->current_matrix, vpos); - for (i = x = 0; i < hpos; ++i) - x += row->glyphs[TEXT_AREA][i].pixel_width; - - /* Record this as the current active region. */ - hlinfo->mouse_face_beg_col = hpos; - hlinfo->mouse_face_beg_row = vpos; - hlinfo->mouse_face_beg_x = x; - hlinfo->mouse_face_past_end = false; - - hlinfo->mouse_face_end_col = hpos + 1; - hlinfo->mouse_face_end_row = vpos; - hlinfo->mouse_face_end_x = x + glyph->pixel_width; - hlinfo->mouse_face_window = window; - hlinfo->mouse_face_face_id = TAB_BAR_FACE_ID; - - /* Display it as active. */ - show_mouse_face (hlinfo, draw); - } - - set_help_echo: - - /* Set help_echo_string to a help string to display for this tab-bar item. - XTread_socket does the rest. */ - help_echo_object = help_echo_window = Qnil; - help_echo_pos = -1; - help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_HELP); - if (NILP (help_echo_string)) - help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION); -} - #endif /* HAVE_WINDOW_SYSTEM */ /* Find the tab-bar item at X coordinate and return its information. */ @@ -33537,13 +33414,9 @@ note_mouse_highlight (struct frame *f, int x, int y) frame_to_window_pixel_xy (w, &x, &y); #if defined (HAVE_WINDOW_SYSTEM) - /* Handle tab-bar window differently since it doesn't display a - buffer. */ + /* We don't highlight tab-bar buttons. */ if (EQ (window, f->tab_bar_window)) - { - note_tab_bar_highlight (f, x, y); - return; - } + return; #endif #if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) diff --git a/test/Makefile.in b/test/Makefile.in index 3cfd60d46c0..84ab4e70aee 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -286,6 +286,8 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c endif +src/emacs-tests.log: ../lib-src/seccomp-filter.c + ## Check that there is no 'automated' subdirectory, which would ## indicate an incomplete merge from an older version of Emacs where ## the tests were arranged differently. diff --git a/test/lisp/calculator-tests.el b/test/lisp/calculator-tests.el new file mode 100644 index 00000000000..9551b1a4c61 --- /dev/null +++ b/test/lisp/calculator-tests.el @@ -0,0 +1,51 @@ +;;; calculator-tests.el --- Test suite for calculator. -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: +(require 'ert) +(require 'calculator) + +(ert-deftest calculator-test-calculator-string-to-number () + (dolist (x '(("" 0.0) + ("+" 0.0) + ("-" 0.0) + ("." 0.0) + ("+." 0.0) + ("-." -0.0) + (".-" 0.0) + ("--." 0.0) + ("-0.0e" -0.0) + ("1e1" 10.0) + ("1e+1" 10.0) + ("1e-1" 0.1) + ("+1e1" 10.0) + ("-1e1" -10.0) + ("+1e-1" 0.1) + ("-1e-1" -0.1) + (".1.e1" 0.1) + (".1..e1" 0.1) + ("1e+1.1" 10.0) + ("-2e-1.1" -0.2))) + (pcase x + (`(,str ,expected) + (let ((calculator-input-radix nil)) + (should (equal (calculator-string-to-number str) expected))))))) + +(provide 'calculator-tests) +;; calculator-tests.el ends here diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5147cd26883..a11832d805e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -41,7 +41,7 @@ "Identity, but hidden from some optimisations." x) -(defconst byte-opt-testsuite-arith-data +(defconst bytecomp-tests--test-cases '( ;; some functional tests (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) @@ -364,17 +364,17 @@ '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c) (t c) (x "a") (x "c") (x c) (x d) (x e))) - (mapcar (lambda (x) (cond ((member '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((member '(a b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1) + ((equal x '(c)) 2)))) '(((a b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1) + ((equal x '(c)) 2)))) '(((a b)) a b (c) (d))) (assoc 'b '((a 1) (b 2) (c 3))) @@ -396,7 +396,7 @@ x) (let ((x 1) (bytecomp-test-var 2) (y 3)) - (list x bytecomp-test-var (bytecomp-get-test-var) y)) + (list x bytecomp-test-var (bytecomp-test-get-var) y)) (progn (defvar d) @@ -430,69 +430,67 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-identity 'a) (setq x 3)) x))) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") + (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) -(defun bytecomp-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) - -(defun bytecomp-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-tests () - "Test the Emacs byte compiler." - (dolist (pat byte-opt-testsuite-arith-data) - (should (bytecomp-check-1 pat)))) - -(defun test-byte-opt-arithmetic (&optional arg) - "Unit test for byte-opt arithmetic operations. -Subtests signal errors if something goes wrong." - (interactive "P") - (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) + (let* ((x 1) + (y (condition-case x + (/ 1 0) + (arith-error x)))) + (list x y)) + + (funcall + (condition-case x + (/ 1 0) + (arith-error (prog1 (lambda (y) (+ y x)) + (setq x 10)))) + 4) + ) + "List of expressions for cross-testing interpreted and compiled code.") + +(defconst bytecomp-tests--test-cases-lexbind-only + `( + ;; This would infloop (and exhaust stack) with dynamic binding. + (let ((f #'car)) + (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) + (funcall f '(1 . 2)))) + ) + "List of expressions for cross-testing interpreted and compiled code. +These are only tested with lexical binding.") + +(defun bytecomp-tests--eval-interpreted (form) + "Evaluate FORM using the Lisp interpreter, returning errors as a +special value." + (condition-case err + (eval form lexical-binding) + (error (list 'bytecomp-check-error (car err))))) + +(defun bytecomp-tests--eval-compiled (form) + "Evaluate FORM using the Lisp byte-code compiler, returning errors as a +special value." (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (pass-face '((t :foreground "green"))) - (fail-face '((t :foreground "red"))) - (print-escape-nonascii t) - (print-escape-newlines t) - (print-quoted t) - v0 v1) - (dolist (pat byte-opt-testsuite-arith-data) - (condition-case err - (setq v0 (eval pat)) - (error (setq v0 (list 'bytecomp-check-error (car err))))) - (condition-case err - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 (list 'bytecomp-check-error (car err))))) - (insert (format "%s" pat)) - (indent-to-column 65) - (if (equal v0 v1) - (insert (propertize "OK" 'face pass-face)) - (insert (propertize "FAIL\n" 'face fail-face)) - (indent-to-column 55) - (insert (propertize (format "[%s] vs [%s]" v0 v1) - 'face fail-face))) - (insert "\n")))) + (byte-compile-warnings nil)) + (condition-case err + (funcall (byte-compile (list 'lambda nil form))) + (error (list 'bytecomp-check-error (car err)))))) + +(ert-deftest bytecomp-tests-lexbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with lexical binding." + (let ((lexical-binding t)) + (dolist (form (append bytecomp-tests--test-cases-lexbind-only + bytecomp-tests--test-cases)) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) + +(ert-deftest bytecomp-tests-dynbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with dynamic binding." + (let ((lexical-binding nil)) + (dolist (form bytecomp-tests--test-cases) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) (defun test-byte-comp-compile-and-load (compile &rest forms) (declare (indent 1)) @@ -584,8 +582,8 @@ Subtests signal errors if something goes wrong." `(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-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") + (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) (ert-deftest bytecomp-warn-wrong-args () (bytecomp--with-warning-test "remq.*3.*2" @@ -611,12 +609,13 @@ Subtests signal errors if something goes wrong." (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () - :expected-result ,(if reverse :failed :passed) (with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile-file ,(ert-resource-file file)) (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning)))))) + (,(if reverse 'should-not 'should) + (re-search-forward ,(string-replace " " "[ \n]+" re-warning) + nil t)))))) (bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" "add-hook.*lexical var") @@ -658,10 +657,10 @@ Subtests signal errors if something goes wrong." "free.*foo") (bytecomp--define-warning-file-test "warn-free-variable-reference.el" - "free.*bar") + "free variable .bar") (bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el" - "make-variable-buffer-local.*not called at toplevel") + "make-variable-buffer-local. not called at toplevel") (bytecomp--define-warning-file-test "warn-interactive-only.el" "next-line.*interactive use only.*forward-line") @@ -670,19 +669,19 @@ Subtests signal errors if something goes wrong." "malformed interactive spec") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" - "foo-obsolete.*obsolete function.*99.99") + "foo-obsolete. is an obsolete function (as of 99.99)") (defvar bytecomp--tests-obsolete-var nil) (make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99") (bytecomp--define-warning-file-test "warn-obsolete-hook.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el" "foo-obs.*obsolete.*99.99" t) (bytecomp--define-warning-file-test "warn-obsolete-variable.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" "bytecomp--tests-obs.*obsolete.*99.99" t) @@ -713,64 +712,64 @@ Subtests signal errors if something goes wrong." (bytecomp--define-warning-file-test "warn-wide-docstring-autoload.el" - "autoload.*foox.*wider than.*characters") + "autoload .foox. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-custom-declare-variable.el" - "custom-declare-variable.*foo.*wider than.*characters") + "custom-declare-variable .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defalias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defconst.el" - "defconst.*foo.*wider than.*characters") + "defconst .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-abbrev-table.el" - "define-abbrev.*foo.*wider than.*characters") + "define-abbrev-table .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-function-alias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-variable-alias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo. docstring wider than .* characters") ;; TODO: We don't yet issue warnings for defuns. (bytecomp--define-warning-file-test "warn-wide-docstring-defun.el" - "wider than.*characters" 'reverse) + "wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-defvar.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defvaralias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-fill-column.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-override.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-multiline-first.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-multiline.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "nowarn-inline-after-defvar.el" @@ -813,47 +812,6 @@ Subtests signal errors if something goes wrong." (defun def () (m)))) (should (equal (funcall 'def) 4))) -(defconst bytecomp-lexbind-tests - `( - (let ((f #'car)) - (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) - (funcall f '(1 . 2)))) - ) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") - -(defun bytecomp-lexbind-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) - -(defun bytecomp-lexbind-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-lexbind-tests () - "Test the Emacs byte compiler lexbind handling." - (dolist (pat bytecomp-lexbind-tests) - (should (bytecomp-lexbind-check-1 pat)))) - (defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) (declare (indent 1)) (cl-check-type file-name-var symbol) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index dd6487603d3..5c3e603b92e 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -629,14 +629,24 @@ collection clause." (let (n1) (and xs (progn (setq n1 (1+ n)) - (len2 (cdr xs) n1))))))) + (len2 (cdr xs) n1)))))) + ;; Tail call in error handler. + (len3 (xs n) + (if xs + (condition-case nil + (/ 1 0) + (arith-error (len3 (cdr xs) (1+ n)))) + n))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) + (should (equal (len3 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) + (should (equal (len3 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) - (should (equal (len2 list-42k 0) 42000)))) + (should (equal (len2 list-42k 0) 42000)) + (should (equal (len3 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index dcb261c2eb9..7d45432e57e 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -1061,5 +1061,30 @@ backtracking (Bug#42701)." "edebug-anon10001" "edebug-tests-duplicate-symbol-backtrack")))))) +(defmacro edebug-tests--duplicate-&define (_arg) + "Helper macro for the ERT test `edebug-tests-duplicate-&define'. +The Edebug specification is similar to the one used by `cl-flet' +previously; see Bug#41988." + (declare (debug (&or (&define name function-form) (defun))))) + +(ert-deftest edebug-tests-duplicate-&define () + "Check that Edebug doesn't backtrack out of `&define' forms. +This avoids potential duplicate definitions (Bug#41988)." + (with-temp-buffer + (print '(defun edebug-tests-duplicate-&define () + (edebug-tests--duplicate-&define + (edebug-tests-duplicate-&define-inner () nil))) + (current-buffer)) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name)))) + (should-error (eval-buffer) :type 'invalid-read-syntax)))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el new file mode 100644 index 00000000000..b29796da42d --- /dev/null +++ b/test/lisp/loadhist-tests.el @@ -0,0 +1,57 @@ +;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefankangas@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'loadhist) + +(ert-deftest loadhist-tests-feature-symbols () + (should (equal (file-name-base (car (feature-symbols 'loadhist))) "loadhist")) + (should-not (feature-symbols 'non-existent-feature))) + +(ert-deftest loadhist-tests-feature-file () + (should (equal (file-name-base (feature-file 'loadhist)) "loadhist")) + (should-error (feature-file 'non-existent-feature))) + +(ert-deftest loadhist-tests-file-loadhist-lookup () + ;; This should probably be extended... + (should (listp (file-loadhist-lookup "loadhist")))) + +(ert-deftest loadhist-tests-file-provides () + (should (eq (car (file-provides "loadhist")) 'loadhist))) + +(ert-deftest loadhist-tests-file-requires () + (should-not (file-requires "loadhist"))) + +(ert-deftest loadhist-tests-file-dependents () + (require 'dired-x) + (let ((deps (file-dependents "dired"))) + (should (member "dired-x" (mapcar #'file-name-base deps))))) + +(ert-deftest loadhist-tests-unload-feature () + (require 'dired-x) + (should-error (unload-feature 'dired)) + (unload-feature 'dired-x)) + +;;; loadhist-tests.el ends here diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 0c2d7123dd7..7b9c2ff63b2 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -117,8 +117,8 @@ (ignore-errors (delete-file shadow-info-file)) (ignore-errors (delete-file shadow-todo-file)) ;; Reset variables. + (shadow-invalidate-hashtable) (setq shadow-info-buffer nil - shadow-hashtable nil shadow-todo-buffer nil shadow-files-to-copy nil)) diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm new file mode 100644 index 00000000000..9053a8743e4 --- /dev/null +++ b/test/manual/indent/scheme.scm @@ -0,0 +1,23 @@ +;; Testing sexp-comments + +(define a #;(hello) there) + +(define a #;1 there) + +(define a #;"asdf" there) + +(define a ;; #;(hello + there) + +(define a #;(hello + there) 2) + +(define a #;(hello + #;(world)) + and) + there) 2) + +(define a #;(hello + #;"asdf" (world + and) + there) 2) diff --git a/test/src/emacs-resources/seccomp-filter-exec.bpf b/test/src/emacs-resources/seccomp-filter-exec.bpf new file mode 120000 index 00000000000..5b0e9978221 --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter-exec.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter-exec.bpf
\ No newline at end of file diff --git a/test/src/emacs-resources/seccomp-filter.bpf b/test/src/emacs-resources/seccomp-filter.bpf new file mode 120000 index 00000000000..b3d603d0aeb --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter.bpf
\ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el new file mode 100644 index 00000000000..09f9a248efb --- /dev/null +++ b/test/src/emacs-tests.el @@ -0,0 +1,213 @@ +;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for src/emacs.c. + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'ert-x) +(require 'rx) +(require 'subr-x) + +(ert-deftest emacs-tests/seccomp/absent-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (should-not (file-exists-p "/does-not-exist.bpf")) + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + "--seccomp=/does-not-exist.bpf") + 0)))) + +(cl-defmacro emacs-tests--with-temp-file + (var (prefix &optional suffix text) &rest body) + "Evaluate BODY while a new temporary file exists. +Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT +to `make-temp-file', which see." + (declare (indent 2) (debug (symbolp (form form form) body))) + (cl-check-type var symbol) + ;; Use an uninterned symbol so that the code still works if BODY + ;; changes VAR. + (let ((filename (make-symbol "filename"))) + `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text))) + (unwind-protect + (let ((,var ,filename)) + ,@body) + (delete-file ,filename))))) + +(ert-deftest emacs-tests/seccomp/empty-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; According to the Seccomp man page, a filter must have at + ;; least one element, so Emacs should reject an empty file. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/file-too-large () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil) + ;; This value should be correct on all supported systems. + (ushort-max #xFFFF) + ;; Either 8 or 16, but 16 should be large enough in all cases. + (filter-size 16)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file + filter ("seccomp-too-large-" ".bpf" + (make-string (* (1+ ushort-max) filter-size) ?a)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The filter count must fit into an `unsigned short'. A bigger + ;; file should be rejected. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/invalid-file-size () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf" + "123456") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The Seccomp filter file must have a file size that's a + ;; multiple of the size of struct sock_filter, which is 8 or 16, + ;; but never 6. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/allows-stdout () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" '(message "Hi"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +(ert-deftest emacs-tests/seccomp/forbids-subprocess () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status + (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" `(call-process ,emacs nil nil nil + "--version"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should-not (eql status 0))))))) + +(ert-deftest emacs-tests/bwrap/allows-stdout () + (let ((bash (executable-find "bash")) + (bwrap (executable-find "bwrap")) + (emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter-exec.bpf")) + (process-environment nil)) + (skip-unless bash) + (skip-unless bwrap) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + (should-not (file-remote-p bwrap)) + (should-not (file-remote-p emacs)) + (should-not (file-remote-p filter)) + (with-temp-buffer + (let* ((command + (concat + (mapconcat #'shell-quote-argument + `(,(file-name-unquote bwrap) + "--ro-bind" "/" "/" + "--seccomp" "20" + "--" + ,(file-name-unquote emacs) + "--quick" "--batch" + ,(format "--eval=%S" '(message "Hi"))) + " ") + " 20< " + (shell-quote-argument (file-name-unquote filter)))) + (status (call-process bash nil t nil "-c" command))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +;;; emacs-tests.el ends here |