[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp f92bb78: Merge remote-tracking branch 'savannah/mast
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp f92bb78: Merge remote-tracking branch 'savannah/master' into native-comp |
|
Date: |
Wed, 17 Feb 2021 16:34:54 -0500 (EST) |
branch: feature/native-comp
commit f92bb788a073c6b3ca7f188e0edea714598193fd
Merge: 1fe5994 6735bb3
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into native-comp
---
admin/CPP-DEFINES | 45 --
admin/check-doc-strings | 57 +-
admin/cus-test.el | 5 +-
configure.ac | 21 +-
doc/emacs/basic.texi | 11 +
doc/emacs/m-x.texi | 12 +-
doc/lispref/commands.texi | 91 ++-
doc/lispref/edebug.texi | 92 +--
doc/lispref/functions.texi | 10 +
doc/lispref/loading.texi | 5 +-
doc/lispref/modes.texi | 22 +
doc/lispref/processes.texi | 35 +-
doc/lispref/text.texi | 7 +-
doc/misc/forms.texi | 3 +-
doc/misc/gnus.texi | 3 +
doc/misc/octave-mode.texi | 5 +-
doc/misc/remember.texi | 3 +-
doc/misc/tramp.texi | 6 +-
etc/NEWS | 124 +++-
lisp/bindings.el | 17 +
lisp/bookmark.el | 80 +--
lisp/buff-menu.el | 56 +-
lisp/calc/calc-sel.el | 4 +-
lisp/calendar/icalendar.el | 26 +-
lisp/cedet/ede/base.el | 29 +-
lisp/cedet/ede/dired.el | 2 +-
lisp/cedet/ede/emacs.el | 27 +-
lisp/cedet/ede/make.el | 2 +-
lisp/cedet/ede/pmake.el | 22 +-
lisp/cedet/ede/proj-archive.el | 4 +-
lisp/cedet/ede/proj-aux.el | 2 +-
lisp/cedet/ede/proj-comp.el | 35 +-
lisp/cedet/ede/proj-misc.el | 2 +-
lisp/cedet/ede/proj-scheme.el | 4 +-
lisp/cedet/ede/srecode.el | 3 +-
lisp/cedet/ede/system.el | 2 +-
lisp/cedet/semantic/bovine/gcc.el | 5 +-
lisp/cedet/semantic/ctxt.el | 24 +-
lisp/cedet/semantic/decorate/include.el | 8 +-
lisp/cedet/semantic/decorate/mode.el | 6 +-
lisp/cedet/semantic/lex-spp.el | 55 +-
lisp/cedet/semantic/lex.el | 38 +-
lisp/cedet/semantic/symref/cscope.el | 4 +-
lisp/cedet/semantic/symref/filter.el | 10 +-
lisp/cedet/semantic/symref/global.el | 2 +-
lisp/cedet/semantic/symref/grep.el | 2 +-
lisp/cedet/semantic/symref/idutils.el | 4 +-
lisp/cedet/semantic/symref/list.el | 2 +-
lisp/cedet/semantic/tag.el | 14 +-
lisp/cedet/semantic/wisent.el | 15 +-
lisp/emacs-lisp/autoload.el | 15 +-
lisp/emacs-lisp/backtrace.el | 8 +-
lisp/emacs-lisp/bindat.el | 314 +++++-----
lisp/emacs-lisp/byte-opt.el | 88 ++-
lisp/emacs-lisp/byte-run.el | 19 +-
lisp/emacs-lisp/bytecomp.el | 76 +--
lisp/emacs-lisp/cl-generic.el | 74 ++-
lisp/emacs-lisp/cl-lib.el | 2 +-
lisp/emacs-lisp/cl-macs.el | 201 ++++---
lisp/emacs-lisp/derived.el | 7 +-
lisp/emacs-lisp/easy-mmode.el | 31 +-
lisp/emacs-lisp/easymenu.el | 5 +-
lisp/emacs-lisp/edebug.el | 645 ++++++++++-----------
lisp/emacs-lisp/eieio-compat.el | 2 +-
lisp/emacs-lisp/eldoc.el | 3 +-
lisp/emacs-lisp/ert.el | 4 +-
lisp/emacs-lisp/gv.el | 12 +-
lisp/emacs-lisp/macroexp.el | 50 +-
lisp/emacs-lisp/pcase.el | 87 ++-
lisp/emacs-lisp/seq.el | 1 +
lisp/erc/erc-backend.el | 14 +-
lisp/erc/erc-button.el | 2 +-
lisp/erc/erc-dcc.el | 2 +-
lisp/erc/erc-identd.el | 2 +-
lisp/erc/erc-join.el | 2 +-
lisp/erc/erc-lang.el | 2 +-
lisp/erc/erc-log.el | 2 +-
lisp/erc/erc-match.el | 2 +-
lisp/erc/erc-menu.el | 2 +-
lisp/erc/erc-pcomplete.el | 2 +-
lisp/erc/erc-replace.el | 2 +-
lisp/erc/erc-sound.el | 7 +-
lisp/erc/erc-spelling.el | 2 +-
lisp/erc/erc-stamp.el | 2 +-
lisp/erc/erc-track.el | 2 +-
lisp/erc/erc-xdcc.el | 2 +-
lisp/eshell/esh-var.el | 2 +-
lisp/files.el | 2 +-
lisp/gnus/deuglify.el | 10 +-
lisp/gnus/gnus-art.el | 276 ++++-----
lisp/gnus/gnus-bookmark.el | 24 +-
lisp/gnus/gnus-cache.el | 8 +-
lisp/gnus/gnus-cite.el | 12 +-
lisp/gnus/gnus-cus.el | 9 +-
lisp/gnus/gnus-delay.el | 8 +-
lisp/gnus/gnus-diary.el | 4 +-
lisp/gnus/gnus-dired.el | 9 +-
lisp/gnus/gnus-draft.el | 6 +-
lisp/gnus/gnus-eform.el | 4 +-
lisp/gnus/gnus-fun.el | 19 +-
lisp/gnus/gnus-gravatar.el | 4 +-
lisp/gnus/gnus-group.el | 276 ++++-----
lisp/gnus/gnus-icalendar.el | 14 +-
lisp/gnus/gnus-int.el | 2 +-
lisp/gnus/gnus-mh.el | 2 +-
lisp/gnus/gnus-msg.el | 93 ++-
lisp/gnus/gnus-picon.el | 8 +-
lisp/gnus/gnus-registry.el | 11 +-
lisp/gnus/gnus-salt.el | 10 +-
lisp/gnus/gnus-score.el | 51 +-
lisp/gnus/gnus-sieve.el | 2 +-
lisp/gnus/gnus-srvr.el | 68 +--
lisp/gnus/gnus-start.el | 4 +-
lisp/gnus/gnus-sum.el | 586 ++++++++++---------
lisp/gnus/gnus-topic.el | 101 ++--
lisp/gnus/gnus-uu.el | 99 ++--
lisp/gnus/gnus-vm.el | 4 +-
lisp/gnus/gnus.el | 44 +-
lisp/gnus/message.el | 138 ++---
lisp/gnus/mml-sec.el | 42 +-
lisp/gnus/mml.el | 2 +-
lisp/gnus/nnagent.el | 1 +
lisp/gnus/score-mode.el | 6 +-
lisp/gnus/smiley.el | 2 +-
lisp/gnus/smime.el | 2 +-
lisp/gnus/spam-report.el | 6 +-
lisp/gnus/spam-stat.el | 1 -
lisp/gnus/spam.el | 11 +-
lisp/help-fns.el | 37 +-
lisp/image-mode.el | 6 +
lisp/image/exif.el | 5 +-
lisp/info.el | 79 +--
lisp/isearch.el | 4 +-
lisp/leim/quail/hangul.el | 22 +-
lisp/leim/quail/indian.el | 14 +-
lisp/leim/quail/ipa.el | 8 +-
lisp/leim/quail/japanese.el | 10 +-
lisp/leim/quail/lao.el | 4 +-
lisp/leim/quail/latin-ltx.el | 2 +-
lisp/leim/quail/lrt.el | 4 +-
lisp/leim/quail/sisheng.el | 2 +-
lisp/leim/quail/thai.el | 2 +-
lisp/leim/quail/tibetan.el | 8 +-
lisp/leim/quail/uni-input.el | 19 +-
lisp/loadup.el | 3 +-
lisp/minibuffer.el | 13 +-
lisp/net/eww.el | 78 +--
lisp/net/shr.el | 1 +
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-gvfs.el | 3 +
lisp/net/tramp-rclone.el | 71 +--
lisp/net/tramp-sh.el | 39 +-
lisp/net/tramp-smb.el | 3 +
lisp/net/tramp-sudoedit.el | 3 +
lisp/net/tramp.el | 10 +-
lisp/net/trampver.el | 5 +
lisp/org/ob-comint.el | 6 +-
lisp/org/ob-core.el | 17 +-
lisp/org/ob-tangle.el | 3 +-
lisp/org/org-agenda.el | 2 +-
lisp/org/org-clock.el | 6 +-
lisp/org/org-pcomplete.el | 11 +-
lisp/pcmpl-gnu.el | 8 +-
lisp/pcmpl-linux.el | 6 +-
lisp/pcmpl-unix.el | 2 +-
lisp/pcmpl-x.el | 3 +-
lisp/play/5x5.el | 31 +-
lisp/play/blackbox.el | 16 +-
lisp/play/decipher.el | 84 ++-
lisp/play/gomoku.el | 109 ++--
lisp/progmodes/bug-reference.el | 3 +-
lisp/progmodes/cfengine.el | 4 -
lisp/progmodes/cmacexp.el | 12 +-
lisp/progmodes/cperl-mode.el | 636 ++++++++++----------
lisp/progmodes/cpp.el | 43 +-
lisp/progmodes/cwarn.el | 9 +-
lisp/progmodes/dcl-mode.el | 75 +--
lisp/progmodes/executable.el | 29 +-
lisp/progmodes/flymake.el | 2 -
lisp/progmodes/gud.el | 28 +-
lisp/progmodes/hideshow.el | 7 +-
lisp/progmodes/icon.el | 21 +-
lisp/progmodes/inf-lisp.el | 15 +-
lisp/progmodes/js.el | 52 +-
lisp/progmodes/ld-script.el | 3 +-
lisp/progmodes/m4-mode.el | 50 +-
lisp/progmodes/make-mode.el | 69 +--
lisp/progmodes/meta-mode.el | 97 ++--
lisp/progmodes/modula2.el | 15 +-
lisp/progmodes/octave.el | 49 +-
lisp/progmodes/pascal.el | 30 +-
lisp/progmodes/perl-mode.el | 4 +-
lisp/progmodes/prog-mode.el | 6 +-
lisp/progmodes/scheme.el | 25 +-
lisp/progmodes/simula.el | 33 +-
lisp/progmodes/xscheme.el | 16 +-
lisp/ps-samp.el | 2 +-
lisp/repeat.el | 71 +++
lisp/shell.el | 5 +-
lisp/simple.el | 171 ++++--
lisp/skeleton.el | 8 +-
lisp/speedbar.el | 9 +-
lisp/subr.el | 158 ++---
lisp/tab-bar.el | 109 ++--
lisp/textmodes/enriched.el | 15 +-
lisp/textmodes/ispell.el | 94 +--
lisp/textmodes/makeinfo.el | 6 +-
lisp/textmodes/paragraphs.el | 7 -
lisp/textmodes/picture.el | 24 +-
lisp/textmodes/refbib.el | 21 +-
lisp/textmodes/refer.el | 12 +-
lisp/textmodes/remember.el | 53 +-
lisp/textmodes/rst.el | 4 -
lisp/textmodes/texinfo.el | 25 +-
lisp/textmodes/tildify.el | 9 -
lisp/textmodes/two-column.el | 18 +-
lisp/thumbs.el | 35 +-
lisp/vc/pcvs-parse.el | 15 +-
lisp/vc/smerge-mode.el | 12 +-
lisp/wid-browse.el | 23 +-
lisp/window.el | 22 +
src/buffer.c | 14 +
src/buffer.h | 3 +
src/callint.c | 9 +-
src/data.c | 87 ++-
src/emacs-module.c | 8 +-
src/eval.c | 41 +-
src/frame.c | 4 +-
src/image.c | 13 +-
src/json.c | 77 +--
src/lisp.h | 4 +
src/minibuf.c | 115 +++-
src/nsterm.h | 1 +
src/nsterm.m | 58 ++
src/pdumper.c | 3 +-
src/window.h | 4 -
src/xdisp.c | 9 +-
src/xfns.c | 7 +-
.../import-rrule-anniversary.diary-american | 2 +-
.../import-rrule-anniversary.diary-european | 2 +-
.../import-rrule-anniversary.diary-iso | 2 +-
.../import-rrule-yearly.diary-american | 2 +-
.../import-rrule-yearly.diary-european | 2 +-
.../import-rrule-yearly.diary-iso | 2 +-
test/lisp/calendar/icalendar-tests.el | 112 ++--
test/lisp/emacs-lisp/bindat-tests.el | 9 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 12 +-
.../edebug-resources/edebug-test-code.el | 20 +-
test/lisp/emacs-lisp/edebug-tests.el | 57 +-
test/lisp/emacs-lisp/macroexp-tests.el | 36 ++
test/lisp/net/tramp-tests.el | 14 +-
.../lisp/progmodes/cperl-mode-resources/grammar.pl | 158 +++++
test/lisp/progmodes/cperl-mode-tests.el | 95 +++
test/lisp/progmodes/elisp-mode-tests.el | 19 +-
test/src/json-tests.el | 28 +
255 files changed, 4843 insertions(+), 3947 deletions(-)
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index a40b430..68c1243 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -81,7 +81,6 @@ anymore, so they can be removed.
AMPERSAND_FULL_NAME
BROKEN_DATAGRAM_SOCKETS
-BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
BROKEN_PTY_READ_AFTER_EAGAIN
DEFAULT_SOUND_DEVICE
@@ -94,16 +93,12 @@ EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
GC_MARK_SECONDARY_STACK
-GC_MARK_STACK
GC_SETJMP_WORKS
GNU_MALLOC
-HAVE_AIX_SMT_EXP
-HAVE_ALARM
HAVE_ALLOCA
HAVE_ALLOCA_H
HAVE_ALSA
HAVE_BDFFONT
-HAVE_BOXES
HAVE_CFMAKERAW
HAVE_CFSETSPEED
HAVE_CLOCK_GETTIME
@@ -117,7 +112,6 @@ HAVE_DBUS_VALIDATE_INTERFACE
HAVE_DBUS_VALIDATE_MEMBER
HAVE_DBUS_VALIDATE_PATH
HAVE_DBUS_WATCH_GET_UNIX_FD
-HAVE_DECL_GETENV
HAVE_DECL_LOCALTIME_R
HAVE_DECL_STRMODE
HAVE_DECL_STRTOIMAX
@@ -126,8 +120,6 @@ HAVE_DECL_STRTOULL
HAVE_DECL_STRTOUMAX
HAVE_DECL_TZNAME
HAVE_DIALOGS
-HAVE_DIFFTIME
-HAVE_DUP2
HAVE_ENDGRENT
HAVE_ENDPWENT
HAVE_ENVIRON_DECL
@@ -141,11 +133,9 @@ HAVE_FUTIMES
HAVE_FUTIMESAT
HAVE_GAI_STRERROR
HAVE_GCONF
-HAVE_GETDELIM
HAVE_GETGRENT
HAVE_GETHOSTNAME
HAVE_GETIFADDRS
-HAVE_GETLINE
HAVE_GETLOADAVG
HAVE_GETOPT_H
HAVE_GETOPT_LONG_ONLY
@@ -164,18 +154,8 @@ HAVE_GPM
HAVE_GRANTPT
HAVE_GSETTINGS
HAVE_GTK3
-HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
-HAVE_GTK_DIALOG_GET_ACTION_AREA
HAVE_GTK_FILE_SELECTION_NEW
-HAVE_GTK_MAIN
-HAVE_GTK_MULTIDISPLAY
-HAVE_GTK_ORIENTABLE_SET_ORIENTATION
-HAVE_GTK_WIDGET_GET_MAPPED
-HAVE_GTK_WIDGET_GET_SENSITIVE
-HAVE_GTK_WIDGET_GET_WINDOW
-HAVE_GTK_WIDGET_SET_HAS_WINDOW
HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
-HAVE_G_TYPE_INIT
HAVE_IFADDRS_H
HAVE_IMAGEMAGICK
HAVE_INTTYPES_H
@@ -193,10 +173,8 @@ HAVE_LIBLOCKFILE
HAVE_LIBMAIL
HAVE_LIBOTF
HAVE_LIBPERFSTAT
-HAVE_LIBPNG_PNG_H
HAVE_LIBSELINUX
HAVE_LIBXML2
-HAVE_LIBXMU
HAVE_LOCALTIME_R
HAVE_LOCAL_SOCKETS
HAVE_LRAND48
@@ -209,24 +187,18 @@ HAVE_MAGICKEXPORTIMAGEPIXELS
HAVE_MAGICKMERGEIMAGELAYERS
HAVE_MAILLOCK_H
HAVE_MALLOC_MALLOC_H
-HAVE_MATHERR
HAVE_MBSTATE_T
-HAVE_MEMCMP
-HAVE_MEMMOVE
HAVE_MEMORY_H
HAVE_MEMSET
-HAVE_MENUS
HAVE_MKSTEMP
HAVE_MMAP
HAVE_MULTILINGUAL_MENU
-HAVE_NANOTIME
HAVE_NET_IF_DL_H
HAVE_NET_IF_H
HAVE_NLIST_H
HAVE_OTF_GET_VARIATION_GLYPHS
HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
HAVE_PNG
-HAVE_PNG_H
HAVE_POSIX_MEMALIGN
HAVE_PROCFS
HAVE_PSELECT
@@ -263,15 +235,12 @@ HAVE_SOUNDCARD_H
HAVE_STDINT_H
HAVE_STDIO_EXT_H
HAVE_STDLIB_H
-HAVE_STLIB_H_1
HAVE_STRINGS_H
HAVE_STRING_H
-HAVE_STRNCASECMP
HAVE_STRSIGNAL
HAVE_STRTOIMAX
HAVE_STRTOLL
HAVE_STRTOULL
-HAVE_STRTOUMAX
HAVE_STRUCT_ERA_ENTRY
HAVE_STRUCT_IFREQ_IFR_ADDR
HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
@@ -287,9 +256,7 @@ HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
-HAVE_STRUCT_TIMEZONE
HAVE_STRUCT_TM_TM_ZONE
-HAVE_STRUCT_UTIMBUF
HAVE_ST_DM_MODE
HAVE_SYMLINK
HAVE_SYNC
@@ -303,26 +270,20 @@ HAVE_SYS_SOCKET_H
HAVE_SYS_SOUNDCARD_H
HAVE_SYS_STAT_H
HAVE_SYS_SYSTEMINFO_H
-HAVE_SYS_TIMEB_H
HAVE_SYS_TIME_H
HAVE_SYS_TYPES_H
HAVE_SYS_UN_H
HAVE_SYS_UTSNAME_H
HAVE_SYS_VLIMIT_H
HAVE_SYS_WAIT_H
-HAVE_TCATTR
HAVE_TERM_H
HAVE_TIFF
-HAVE_TIMEVAL
HAVE_TM_GMTOFF
HAVE_TM_ZONE
HAVE_TOUCHLOCK
HAVE_TZNAME
-HAVE_TZSET
HAVE_UTIL_H
HAVE_UTIMENSAT
-HAVE_UTIMES
-HAVE_UTIME_H
HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
@@ -342,14 +303,10 @@ HAVE_XRMSETDATABASE
HAVE_XSCREENNUMBEROFSCREEN
HAVE_XSCREENRESOURCESTRING
HAVE_X_I18N
-HAVE_X_MENU
HAVE_X_SM
HAVE_X_WINDOWS
-HAVE__BOOL
-HAVE__FTIME
HAVE___BUILTIN_UNWIND_INIT
HAVE___EXECUTABLE_START
-HAVE___FPENDING
INTERNAL_TERMINAL
IS_ANY_SEP
IS_DIRECTORY_SEP
@@ -359,7 +316,6 @@ MAIL_USE_POP
MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
NLIST_STRUCT
-NO_EDITRES
NSIG
NSIG_MINIMUM
NULL_DEVICE
@@ -378,7 +334,6 @@ SYSTEM_MALLOC
TAB3
TABDLY
TERM
-TIME_WITH_SYS_TIME
TIOCSIGSEND
TM_IN_SYS_TIME
UNIX98_PTYS
diff --git a/admin/check-doc-strings b/admin/check-doc-strings
index 63856d3..135090b 100755
--- a/admin/check-doc-strings
+++ b/admin/check-doc-strings
@@ -59,7 +59,7 @@ sub Check_texi_function {
$arglist_parm{$parm} = 1;
}
- foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
+ foreach my $parm ($docstring =~ /\@var\{([^{}]+)\}/g) {
$docstring_parm{$parm} = 1;
}
@@ -111,7 +111,9 @@ sub Check_function {
# $arglist_parm{$parm} = 1;
#}
foreach my $parm (@parms) {
- next if $parm eq '&optional' || $parm eq '&rest';
+ next if $parm eq '&optional'
+ || $parm eq '&rest'
+ || $parm eq 'Lisp-Object';
$arglist_parm{$parm} = 1;
}
my $doc_tmp = $docstring;
@@ -150,6 +152,22 @@ sub Check_function {
next if $parm eq 'primary';
next if $parm eq 'secondary';
next if $parm eq 'clipboard';
+ next if $parm eq 'bbdb';
+ next if $parm eq 'dos';
+ next if $parm eq 'erc';
+ next if $parm eq 'exif';
+ next if $parm eq 'ldap';
+ next if $parm eq 'ime';
+ next if $parm eq 'rfc';
+ next if $parm eq 'ms-dos';
+ next if $parm eq 'url';
+ next if $parm eq 'w32';
+ next if $parm eq 'todo'; # org-mode
+ next if $parm eq 'done'; # org-mode
+ next if $parm eq 'waiting'; #org-mode
+ next if $parm eq 'ordered'; #org-mode
+ next if $parm eq 'deadline'; #org-mode
+ next if $parm eq 'scheduled'; #org-mode
next if length $parm < 3;
if (! exists $arglist_parm{$parm}) {
print "bogus parm: $function: $parm\n";
@@ -228,20 +246,43 @@ open (FIND, "find src -name '*.c' -print |") or die;
while (my $file = <FIND>) {
my @matches =
((FileContents $file) =~
-
/\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
+ /\b
+ DEFUN\s*\(\s*
+ ## $function
+ \"((?:[^\\\"]|\\.)+)\"\s*,
+ \s*\S+\s*, \s*\S+\s*,
+ ## $minargs
+ \s*(\S+)\s*,
+ ## $maxargs
+ \s*(\S+)\s*,
+ ## $interactive
+ \s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,
+ ## $docstring
+ \s*doc:\s*\/\*\s*(.*?)\s*\*\/
+ # attributes -- skip
+ (?:\s*attributes:\s*
+ (?:noreturn|const)
+ \s*)?
+ \s*\)
+ ### $parms
+ \s*\(
+ ([^()]*)
+ \)
+ /sgox);
while (@matches) {
my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) =
splice (@matches, 0, 6);
$docstring =~ s/^\n+//s;
$docstring =~ s/\n+$//s;
$parms =~ s/,/ /g;
- my @parms = split (' ',$parms);
+ my @parms = $parms eq 'void' ? () : split (' ', $parms);
for (@parms) { tr/_/-/; s/-$//; }
if ($parms !~ /Lisp_Object/) {
if ($minargs < @parms) {
- if ($maxargs =~ /^\d+$/) {
- die unless $maxargs eq @parms;
- splice (@parms, $minargs, 0, '&optional');
- }
+ if ($maxargs =~ /^\d+$/) {
+ die "$function: $maxargs"
+ unless $maxargs eq @parms;
+ splice (@parms, $minargs, 0, '&optional');
+ }
}
}
my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 995586f..afd5f4c 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -320,7 +320,8 @@ If it is \"all\", load all Lisp files."
(lambda (file)
(condition-case alpha
(unless (member file cus-test-libs-noloads)
- (load (file-name-sans-extension (expand-file-name file lispdir)))
+ (load (file-name-sans-extension (expand-file-name file lispdir))
+ nil t)
(push file cus-test-libs-loaded))
(error
(push (cons file alpha) cus-test-libs-errors)
@@ -349,6 +350,8 @@ Optional argument ALL non-nil means list all (non-obsolete)
Lisp files."
(mapcar (lambda (e) (substring e 2))
(apply #'process-lines find-program
"." "-name" "obsolete" "-prune" "-o"
+ "-name" "ldefs-boot.el" "-prune" "-o"
+ "-name" "*loaddefs.el" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
'("-print")
diff --git a/configure.ac b/configure.ac
index 4691d57..fe0dc92 100644
--- a/configure.ac
+++ b/configure.ac
@@ -410,19 +410,18 @@ dnl This should be the last --with option, because
--with-x is
dnl added later on when we find the file name of X, and it's best to
dnl keep them together visually.
AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
- [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena,
motif, no)])],
+ [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena,
no)])],
[ case "${withval}" in
y | ye | yes ) val=gtk ;;
n | no ) val=no ;;
l | lu | luc | luci | lucid ) val=lucid ;;
a | at | ath | athe | athen | athena ) val=athena ;;
- m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
AC_MSG_ERROR(['--with-x-toolkit=$withval' is invalid;
-this option's value should be 'yes', 'no', 'lucid', 'athena', 'motif', 'gtk',
+this option's value should be 'yes', 'no', 'lucid', 'athena', 'gtk',
'gtk2' or 'gtk3'. 'yes' and 'gtk' are synonyms.
'athena' and 'lucid' are synonyms.])
;;
@@ -461,7 +460,7 @@ OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text
shaping])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping])
-OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif/Xaw3d/GTK toolkit
scroll bars])
+OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Xaw3d/GTK toolkit scroll
bars])
OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d])
OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off])
OPTION_DEFAULT_ON([xdbe],[don't use X11 double buffering support])
@@ -1770,8 +1769,8 @@ fi
dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define 'bool'.
-AC_CHECK_HEADERS(term.h, , , -)
-AC_HEADER_TIME
+AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[#include <term.h>]],[[]])],
+ AC_DEFINE(HAVE_TERM_H, 1, [Define to 1 if you have the <term.h> header
file.]))
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS_ONCE(sys/socket.h)
@@ -2255,7 +2254,7 @@ if test "$window_system" = none && test "X$with_x" !=
"Xno"; then
then
AC_MSG_ERROR([You seem to be running X, but no X development libraries
were found. You should install the relevant development files for X
-and for the toolkit you want, such as Gtk+ or Motif. Also make
+and for the toolkit you want, such as Gtk+. Also make
sure you have development files for image handling, i.e.
tiff, gif, jpeg, png and xpm.
If you are sure you want Emacs compiled without X window support, pass
@@ -4828,10 +4827,10 @@ if test "$USE_X_TOOLKIT" != "none"; then
else
OTHERLIBS="-lXt -$LIBXMU"
fi
- AC_TRY_LINK(
- [#include <X11/Intrinsic.h>
- #include <X11/Xmu/Editres.h>],
- [_XEditResCheckMessages (0, 0, 0, 0);],
+ AC_LINK_IFELSE([AC_LANG_PROGRAM(
+ [[#include <X11/Intrinsic.h>
+ #include <X11/Xmu/Editres.h>]],
+ [[_XEditResCheckMessages (0, 0, 0, 0);]])],
[AC_DEFINE([X_TOOLKIT_EDITRES], 1,
[Define to 1 if we should use XEditRes.])])
LIBS=$OLDLIBS
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 444b28f..8bf52d5 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -880,3 +880,14 @@ characters. You can repeat that command (including its
argument) three
additional times, to delete a total of 80 characters, by typing @kbd{C-x
z z z}. The first @kbd{C-x z} repeats the command once, and each
subsequent @kbd{z} repeats it once again.
+
+@findex repeat-mode
+ Also you can activate @code{repeat-mode} that temporarily enables
+a transient mode with short keys after a limited number of commands.
+Currently supported shorter key sequences are @kbd{C-x u u} instead of
+@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of
+@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^
+v v} to resize the selected window interactively, @kbd{M-g n n p p} to
+navigate @code{next-error} matches. Any other key exits transient mode
+and then is executed normally. The user option @code{repeat-exit-key}
+defines an additional key to exit this transient mode.
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index 865220f..c51f10a 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -46,9 +46,17 @@ from running the command by name.
@cindex obsolete command
When @kbd{M-x} completes on commands, it ignores the commands that
are declared @dfn{obsolete}; for these, you will have to type their
-full name. Obsolete commands are those for which newer, better
+full name. (Obsolete commands are those for which newer, better
alternatives exist, and which are slated for removal in some future
-Emacs release.
+Emacs release.)
+
+@vindex read-extended-command-predicate
+ In addition, @kbd{M-x} completion can exclude commands that are not
+relevant to, and generally cannot work with, the current buffer's
+major mode (@pxref{Major Modes}) and minor modes (@pxref{Minor
+Modes}). By default, no commands are excluded, but you can customize
+the option @code{read-extended-command-predicate} to exclude those
+irrelevant commands from completion results.
To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead
of entering the command name. This takes you back to command level.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 3a2c7d0..85376cc 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -144,6 +144,7 @@ commands by adding the @code{interactive} form to them.
* Interactive Codes:: The standard letter-codes for reading arguments
in various ways.
* Interactive Examples:: Examples of how to read interactive arguments.
+* Command Modes:: Specifying that commands are for a specific mode.
* Generic Commands:: Select among command alternatives.
@end menu
@@ -156,7 +157,7 @@ commands by adding the @code{interactive} form to them.
makes a Lisp function an interactively-callable command, and how to
examine a command's @code{interactive} form.
-@defspec interactive arg-descriptor
+@defspec interactive &optional arg-descriptor &rest modes
This special form declares that a function is a command, and that it
may therefore be called interactively (via @kbd{M-x} or by entering a
key sequence bound to it). The argument @var{arg-descriptor} declares
@@ -177,6 +178,10 @@ forms are executed; at this time, if the
@code{interactive} form
occurs within the body, the form simply returns @code{nil} without
even evaluating its argument.
+The @var{modes} list allows specifying which modes the command is
+meant to be used in. See @ref{Command Modes} for more details about
+the effect of specifying @var{modes}, and when to use it.
+
By convention, you should put the @code{interactive} form in the
function body, as the first top-level form. If there is an
@code{interactive} form in both the @code{interactive-form} symbol
@@ -588,6 +593,76 @@ Put them into three windows, selecting the last one."
@end group
@end example
+@node Command Modes
+@subsection Specifying Modes For Commands
+
+Many commands in Emacs are general, and not tied to any specific mode.
+For instance, @kbd{M-x kill-region} can be used pretty in pretty much
+any mode that has editable text, and commands that display information
+(like @kbd{M-x list-buffers}) can be used in pretty much any context.
+
+Many other commands, however, are specifically tied to a mode, and
+make no sense outside of that context. For instance, @code{M-x
+dired-diff} will just signal an error used outside of a dired buffer.
+
+Emacs therefore has a mechanism for specifying what mode (or modes) a
+command ``belong'' to:
+
+@lisp
+(defun dired-diff (...)
+ ...
+ (interactive "p" dired-mode)
+ ...)
+@end lisp
+
+This will mark the command as applicable to @code{dired-mode} only (or
+any modes that are derived from @code{dired-mode}). Any number of
+modes can be added to the @code{interactive} form.
+
+@vindex read-extended-command-predicate
+Specifying modes may affect completion in @kbd{M-x}, depending on the
+value of @code{read-extended-command-predicate}.
+
+For instance, when using the
+@code{command-completion-default-include-p} predicate, @kbd{M-x} won't
+list commands that have been marked as being applicable to a specific
+mode (unless you are in a buffer that uses that mode, of course).
+This goes for both major and minor modes.
+
+Marking commands this way will also make @kbd{C-h m} list these
+commands (if they aren't bound to any keys).
+
+If using this extended @code{interactive} form isn't convenient
+(because the code is supposed to work in older versions of Emacs that
+doesn't support the extended @code{interactive} form), the following
+can be used instead:
+
+@lisp
+(declare (modes dired-mode))
+@end lisp
+
+Which commands to tag with modes is to some degree a matter of taste,
+but commands that clearly do not work outside of the mode should be
+tagged. This includes commands that will signal an error if called
+from somewhere else, but also commands that are destructive when
+called from an unexpected mode. (This usually includes most of the
+commands that are written for special (i.e., non-editing) modes.)
+
+Some commands may be harmless, and ``work'' when called from other
+modes, but should still be tagged with a mode if they don't actually
+make much sense to use elsewhere. For instance, many special modes
+have commands to exit the buffer bound to @kbd{q}, and may not do
+anything but issue a message like "Goodbye from this mode" and then
+call @code{kill-buffer}. This command will ``work'' from any mode,
+but it is highly unlikely that anybody would actually want to use the
+command outside the context of this special mode.
+
+Many modes have a set of different commands that start that start the
+mode in different ways, (e.g., @code{eww-open-in-new-buffer} and
+@code{eww-open-file}). Commands like that should never be tagged as
+mode-specific, as then can be issued by the user from pretty much any
+context.
+
@node Generic Commands
@subsection Select among Command Alternatives
@cindex generic commands
@@ -756,6 +831,20 @@ part of the prompt.
@result{} t
@end group
@end example
+
+@vindex read-extended-command-predicate
+@findex command-completion-default-include-p
+This command heeds the @code{read-extended-command-predicate}
+variable, which can filter out commands that are not applicable to the
+current major mode (or enabled minor modes). By default, the value of
+this variable is @code{nil}, and no commands are filtered out.
+However, customizing it to invoke the function
+@code{command-completion-default-include-p} will perform
+mode-dependent filtering. @code{read-extended-command-predicate} can
+be any predicate function; it will be called with two parameters: the
+command's symbol and the current buffer. If should return
+non-@code{nil} if the command is to be included when completing in
+that buffer.
@end deffn
@node Distinguish Interactive
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 569545d..8942f55 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1203,7 +1203,7 @@ define Edebug specifications for special forms
implemented in C.
@defmac def-edebug-spec macro specification
Specify which expressions of a call to macro @var{macro} are forms to be
-evaluated. @var{specification} should be the edebug specification.
+evaluated. @var{specification} should be the Edebug specification.
Neither argument is evaluated.
The @var{macro} argument can actually be any symbol, not just a macro
@@ -1290,14 +1290,6 @@ Short for @code{&rest form}. See @code{&rest} below.
If your macro
wraps its body of code with @code{lambda} before it is evaluated, use
@code{def-body} instead. See @code{def-body} below.
-@item function-form
-A function form: either a quoted function symbol, a quoted lambda
-expression, or a form (that should evaluate to a function symbol or
-lambda expression). This is useful when an argument that's a lambda
-expression might be quoted with @code{quote} rather than
-@code{function}, since it instruments the body of the lambda expression
-either way.
-
@item lambda-expr
A lambda expression with no quoting.
@@ -1370,6 +1362,21 @@ is primarily used to generate more specific syntax error
messages. See
edebug-spec; it aborts the instrumentation, displaying the message in
the minibuffer.
+@item &interpose
+Lets a function control the parsing of the remaining code.
+It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}}
+and means that Edebug will first match @var{spec} against the code and
+then call @var{fun} with the code that matched @code{spec}, a parsing
+function @var{pf}, and finally @var{args...}. The parsing
+function expects a single argument indicating the specification list
+to use to parse the remaining code. It should be called exactly once
+and returns the instrumented code that @var{fun} is expected to return.
+For example @code{(&interpose symbolp pcase--match-pat-args)} matches
+sexps whose first element is a symbol and then lets
+@code{pcase--match-pat-args} lookup the specs associated
+with that head symbol according to @code{pcase--match-pat-args} and
+pass them to the @var{pf} it received as argument.
+
@item @var{other-symbol}
@cindex indirect specifications
Any other symbol in a specification list may be a predicate or an
@@ -1378,8 +1385,13 @@ indirect specification.
If the symbol has an Edebug specification, this @dfn{indirect
specification} should be either a list specification that is used in
place of the symbol, or a function that is called to process the
-arguments. The specification may be defined with @code{def-edebug-spec}
-just as for macros. See the @code{defun} example.
+arguments. The specification may be defined with
+@code{def-edebug-elem-spec}:
+
+@defun def-edebug-elem-spec element specification
+Define the @var{specification} to use in place of the symbol @var{element}.
+@var{specification} has to be a list.
+@end defun
Otherwise, the symbol should be a predicate. The predicate is called
with the argument, and if the predicate returns @code{nil}, the
@@ -1428,29 +1440,23 @@ Here is a list of additional specifications that may
appear only after
@code{&define}. See the @code{defun} example.
@table @code
+@item &name
+Extracts the name of the current defining form from the code.
+It takes the form @code{&name [@var{prestring}] @var{spec}
+[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will
+match @var{spec} against the code and then call @var{fun} with the
+concatenation of the current name, @var{args...}, @var{prestring},
+the code that matched @code{spec}, and @var{poststring}. If @var{fun}
+is absent, it defaults to a function that concatenates the arguments
+(with an @code{@@} between the previous name and the new).
+
@item name
The argument, a symbol, is the name of the defining form.
+Shorthand for @code{[&name symbolp]}.
A defining form is not required to have a name field; and it may have
multiple name fields.
-@item :name
-This construct does not actually match an argument. The element
-following @code{:name} should be a symbol; it is used as an additional
-name component for the definition. You can use this to add a unique,
-static component to the name of the definition. It may be used more
-than once.
-
-@item :unique
-This construct is like @code{:name}, but generates unique names. It
-does not match an argument. The element following @code{:unique}
-should be a string; it is used as the prefix for an additional name
-component for the definition. You can use this to add a unique,
-dynamic component to the name of the definition. This is useful for
-macros that can define the same symbol multiple times in different
-scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
-be used more than once.
-
@item arg
The argument, a symbol, is the name of an argument of the defining form.
However, lambda-list keywords (symbols starting with @samp{&})
@@ -1557,14 +1563,14 @@ specification for @code{defmacro} is very similar to
that for
[&optional ("interactive" interactive)]
def-body))
-(def-edebug-spec lambda-list
- (([&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )))
+(def-edebug-elem-spec 'lambda-list
+ '(([&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )))
-(def-edebug-spec interactive
- (&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
+(def-edebug-elem-spec 'interactive
+ '(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
@end smallexample
The specification for backquote below illustrates how to match
@@ -1577,11 +1583,11 @@ could fail.)
@smallexample
(def-edebug-spec \` (backquote-form)) ; @r{Alias just for clarity.}
-(def-edebug-spec backquote-form
- (&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
- (backquote-form . [&or nil backquote-form])
- (vector &rest backquote-form)
- sexp))
+(def-edebug-elem-spec 'backquote-form
+ '(&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
+ (backquote-form . [&or nil backquote-form])
+ (vector &rest backquote-form)
+ sexp))
@end smallexample
@@ -1624,10 +1630,10 @@ option. @xref{Instrumenting}.
@defopt edebug-eval-macro-args
When this is non-@code{nil}, all macro arguments will be instrumented
-in the generated code. For any macro, an @code{edebug-form-spec}
+in the generated code. For any macro, the @code{debug} declaration
overrides this option. So to specify exceptions for macros that have
-some arguments evaluated and some not, use @code{def-edebug-spec} to
-specify an @code{edebug-form-spec}.
+some arguments evaluated and some not, use the @code{debug} declaration
+specify an Edebug form specification.
@end defopt
@defopt edebug-save-windows
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 414035f..1e3da8e 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -2309,6 +2309,16 @@ form @code{(lambda (@var{arg}) @var{body})} in which
case that function will
additionally have access to the macro (or function)'s arguments and it will
be passed to @code{gv-define-setter}.
+@item (completion @var{completion-predicate})
+Declare @var{completion-predicate} as a function to determine whether
+to include the symbol in the list of functions when asking for
+completions in @kbd{M-x}. @var{completion-predicate} is called with
+two parameters: The first parameter is the symbol, and the second is
+the current buffer.
+
+@item (modes @var{modes})
+Specify that this command is meant to be applicable for @var{modes}
+only.
@end table
@end defmac
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 22f0dde..8c6aeb0 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -510,6 +510,9 @@ specification is not given here; it's not needed unless the
user
actually calls @var{function}, and when that happens, it's time to load
the real definition.
+If @var{interactive} is a list, it is interpreted as a list of modes
+this command is applicable for.
+
You can autoload macros and keymaps as well as ordinary functions.
Specify @var{type} as @code{macro} if @var{function} is really a macro.
Specify @var{type} as @code{keymap} if @var{function} is really a
@@ -1125,7 +1128,7 @@ You don't need to give a directory or extension in the
file name
@var{library}. Normally, you just give a bare file name, like this:
@example
-(with-eval-after-load "edebug" (def-edebug-spec c-point t))
+(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval))
@end example
To restrict which files can trigger the evaluation, include a
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index ce7727b..e1299b5 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -861,6 +861,13 @@ abbrev table as @var{parent}, or
@code{fundamental-mode-abbrev-table}
if @var{parent} is @code{nil}. (Again, a @code{nil} value is
@emph{not} equivalent to not specifying this keyword.)
+@item :interactive
+Modes are interactive commands by default. If you specify a
+@code{nil} value, the mode defined here won't be interactive. This is
+useful for modes that are never meant to be activated by users
+manually, but are only supposed to be used in some specially-formatted
+buffer.
+
@item :group
If this is specified, the value should be the customization group for
this mode. (Not all major modes have one.) The command
@@ -1454,6 +1461,16 @@ used only with Diff mode.
other minor modes in effect. It should be possible to activate and
deactivate minor modes in any order.
+@defvar local-minor-modes
+This buffer-local variable lists the currently enabled minor modes in
+the current buffer, and is a list of symbols.
+@end defvar
+
+@defvar global-minor-modes
+This variable lists the currently enabled global minor modes, and is a
+list of symbols.
+@end defvar
+
@defvar minor-mode-list
The value of this variable is a list of all minor mode commands.
@end defvar
@@ -1730,6 +1747,11 @@ and @var{set} is a function of one argument (a state)
that sets it.
@item :after-hook @var{after-hook}
This defines a single Lisp form which is evaluated after the mode hooks
have run. It should not be quoted.
+
+@item :interactive @var{value}
+Minor modes are interactive commands by default. If @var{value} is
+@code{nil}, this is inhibited. If @var{value} is a list of symbols,
+it's used to say which major modes this minor mode is useful in.
@end table
Any other keyword arguments are passed directly to the
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 8346165..bb4c57a 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3368,6 +3368,11 @@ processed, and how to pack or unpack it. We normally
keep bindat specs
in variables whose names end in @samp{-bindat-spec}; that kind of name
is automatically recognized as risky.
+@defmac bindat-spec &rest specs
+Creates a Bindat spec object according to the data layout
+specification @var{specs}.
+@end defmac
+
@cindex endianness
@cindex big endian
@cindex little endian
@@ -3398,12 +3403,16 @@ Unsigned integer in network byte order, with length 3.
@itemx dword
@itemx long
Unsigned integer in network byte order, with length 4.
-Note: These values may be limited by Emacs's integer implementation limits.
+
+@item u64
+Unsigned integer in network byte order, with length 8.
@item u16r
@itemx u24r
@itemx u32r
-Unsigned integer in little endian order, with length 2, 3 and 4, respectively.
+@itemx u64r
+Unsigned integer in little endian order, with length 2, 3, 4, and
+8, respectively.
@item str @var{len}
String of length @var{len}.
@@ -3534,16 +3543,16 @@ repetition has completed.
@node Bindat Functions
@subsection Functions to Unpack and Pack Bytes
- In the following documentation, @var{spec} refers to a data layout
-specification, @code{bindat-raw} to a byte array, and @var{struct} to an
-alist representing unpacked field data.
+ In the following documentation, @var{spec} refers to a Bindat spec
+object as returned from @code{bindat-spec}, @code{raw} to a byte
+array, and @var{struct} to an alist representing unpacked field data.
-@defun bindat-unpack spec bindat-raw &optional bindat-idx
+@defun bindat-unpack spec raw &optional idx
@c FIXME? Again, no multibyte?
This function unpacks data from the unibyte string or byte
-array @code{bindat-raw}
+array @var{raw}
according to @var{spec}. Normally, this starts unpacking at the
-beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it
+beginning of the byte array, but if @var{idx} is non-@code{nil}, it
specifies a zero-based starting position to use instead.
The value is an alist or nested alist in which each element describes
@@ -3576,15 +3585,15 @@ This function returns the total length of the data in
@var{struct},
according to @var{spec}.
@end defun
-@defun bindat-pack spec struct &optional bindat-raw bindat-idx
+@defun bindat-pack spec struct &optional raw idx
This function returns a byte array packed according to @var{spec} from
the data in the alist @var{struct}. It normally creates and fills a
-new byte array starting at the beginning. However, if @var{bindat-raw}
+new byte array starting at the beginning. However, if @var{raw}
is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to
-pack into. If @var{bindat-idx} is non-@code{nil}, it specifies the starting
-offset for packing into @code{bindat-raw}.
+pack into. If @var{idx} is non-@code{nil}, it specifies the starting
+offset for packing into @var{raw}.
-When pre-allocating, you should make sure @code{(length @var{bindat-raw})}
+When pre-allocating, you should make sure @code{(length @var{raw})}
meets or exceeds the total length to avoid an out-of-range error.
@end defun
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index b367346..e47e851 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5288,10 +5288,9 @@ object parsed.
Signaled when encountering invalid JSON syntax.
@end table
- Only top-level values (arrays and objects) can be serialized to
-JSON@. The subobjects within these top-level values can be of any
-type. Likewise, the parsing functions will only return vectors,
-hashtables, alists, and plists.
+ Top-level values and the subobjects within these top-level values
+can be serialized to JSON@. Likewise, the parsing functions will
+return any of the possible types described above.
@defun json-serialize object &rest args
This function returns a new Lisp string which contains the JSON
diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi
index 3d7ac96..15fcd97 100644
--- a/doc/misc/forms.texi
+++ b/doc/misc/forms.texi
@@ -6,6 +6,7 @@
@setfilename ../../info/forms.info
@settitle Forms Mode User's Manual
@include docstyle.texi
+@include emacsver.texi
@syncodeindex vr cp
@syncodeindex fn cp
@syncodeindex ky cp
@@ -47,7 +48,7 @@ modify this GNU manual.''
@sp 4
@center Forms-Mode version 2
@sp 1
-@center for GNU Emacs 22.1
+@center for GNU Emacs @value{EMACSVER}
@sp 1
@center April 2007
@sp 5
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 5a79cbc..fef066d 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -19357,6 +19357,9 @@ and dormant. If @code{nil} (which is the default),
only read articles
are eligible for expiry, and unread, ticked and dormant articles will
be kept indefinitely.
+The last (i.e., newest) article in a group will normally not be
+expired (due to internal book-keeping reasons).
+
If you find that some articles eligible for expiry are never expired,
perhaps some Gnus Agent files are corrupted. There's are special
commands, @code{gnus-agent-regenerate} and
diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi
index 1adc268..e330606 100644
--- a/doc/misc/octave-mode.texi
+++ b/doc/misc/octave-mode.texi
@@ -83,9 +83,12 @@ addition to the standard Emacs commands.
@kindex C-M-j
@findex octave-indent-new-comment-line
@vindex octave-continuation-string
+@vindex octave-string-continuation-marker
Break Octave line at point, continuing comment if within one. Insert
@code{octave-continuation-string} before breaking the line unless
-inside a list. Signal an error if within a single-quoted string.
+inside a list. If within a double-quoted string, insert
+@code{octave-string-continuation-marker} instead. Signal an error if
+within a single-quoted string.
@item C-c ;
@kindex C-c ;
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index 80065be..91e67a8 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -3,11 +3,12 @@
@setfilename ../../info/remember.info
@settitle Remember Manual
@include docstyle.texi
+@include emacsver.texi
@syncodeindex fn cp
@c %**end of header
@copying
-This manual is for Remember Mode, version 2.0
+This manual is for Remember Mode, as distributed with Emacs @value{EMACSVER}.
Copyright @copyright{} 2001, 2004--2005, 2007--2021 Free Software
Foundation, Inc.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index c2e9fe6..6d60215 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2083,10 +2083,12 @@ there is no effect of this property.
@item @t{"mount-args"}@*
@t{"copyto-args"}@*
-@t{"moveto-args"}
+@t{"moveto-args"}@*
+@t{"about-args"}
These properties keep optional flags to the different @option{rclone}
-operations. Their default value is @code{nil}.
+operations. See their default values in @code{tramp-methods} if you
+want to change their values.
@end itemize
diff --git a/etc/NEWS b/etc/NEWS
index f9d3ea1..3e06cc4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,6 +24,9 @@ applies, and please also update docstrings as needed.
* Installation Changes in Emacs 28.1
+--
+** Support for building with Motif has been removed.
+
** Cairo graphics library is now used by default if found.
'--with-cairo' is now the default, if the appropriate development files
are found by 'configure'. Note that building with Cairo means using
@@ -248,6 +251,15 @@ commands. The new keystrokes are 'C-x x g'
('revert-buffer'),
* Editing Changes in Emacs 28.1
++++
+** New user option 'read-extended-command-predicate'.
+This option controls how 'M-x' performs completion of commands when
+you type TAB. By default, any command that matches what you have
+typed is considered a completion candidate, but you can customize this
+option to exclude commands that are not applicable to the current
+buffer's major and minor modes, and respect the command's completion
+predicate (if any).
+
---
** 'eval-expression' now no longer signals an error on incomplete expressions.
Previously, typing 'M-: ( RET' would result in Emacs saying "End of
@@ -349,6 +361,11 @@ the buffer cycles the whole buffer between "only top-level
headings",
It used to be enabled when Emacs is started in GUI mode but not when started
in text mode. The cursor still only actually blinks in GUI frames.
+** Bindat
++++
+*** New types 'u64' and 'u64r'
++++
+*** New macro 'bindat-spec' to define specs, with Edebug support
** pcase
+++
@@ -455,6 +472,9 @@ It can be used to enable/disable the tab bar individually
on each frame
independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
---
+*** New command 'tab-duplicate'.
+
+---
*** New user option 'tab-bar-tab-name-format-function'.
---
@@ -932,14 +952,35 @@ To customize obsolete user options, use
'customize-option' or
** Edebug
+---
+*** Obsoletions
+**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
+
+++
-*** Edebug specification lists can use the new keyword '&error', which
-unconditionally aborts the current edebug instrumentation with the
-supplied error message.
+**** The spec operator ':name NAME' is obsolete, use '&name' instead.
++++
+**** The spec element 'function-form' is obsolete, use 'form' instead.
+
++++
+*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
+These used to be defined with 'def-edebug-spec' thus conflating the
+two name spaces, which lead to name collisions.
+The use of 'def-edebug-spec' to define Edebug spec elements is
+declared obsolete.
+
+*** Edebug specification lists can use some new keywords:
+
++++
+**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
+More specifically, FUN is called with 'HEAD PF ARGS..' where
+PF is a parsing function that expects a single argument (the specs to
+use) and HEAD is the code that matched SPEC.
-*** Edebug specification lists can use the new keyword ':unique',
-which appends a unique suffix to the Edebug name of the current
-definition.
++++
+**** '&error MSG' unconditionally aborts the current edebug instrumentation.
+
++++
+**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
** ElDoc
@@ -2022,6 +2063,26 @@ could have saved enough typing by using an abbrev, a
hint will be
displayed in the echo area, mentioning the abbrev that could have been
used instead.
+** Octave Mode
+
++++
+*** Line continuations in double-quoted strings now use a backslash.
+Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows
+the behavior introduced in Octave 3.8 of using a backslash as a line
+continuation marker within double-quoted strings, and an ellipsis
+everywhere else.
+
+** Repeat
+
++++
+*** New transient mode 'repeat-mode' to allow shorter key sequences.
+You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
+'C-x o o' instead of 'C-x o C-x o' to switch several windows,
+'C-x { { } } ^ ^ v v' to resize the selected window interactively,
+'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).
+
* New Modes and Packages in Emacs 28.1
@@ -2052,11 +2113,14 @@ first).
* Incompatible Editing Changes in Emacs 28.1
-** The 'M-o' ('facemanu-keymap') global binding has been removed.
+** The 'M-o' ('facemenu-keymap') global binding has been removed.
** The 'M-o M-s' and 'M-o M-S' global bindings have been removed.
Use 'M-x center-line' and 'M-x center-paragraph' instead.
+** The 'M-o M-o' global binding have been removed.
+Use 'M-x font-lock-fontify-block' instead.
+
** In 'f90-mode', the backslash character ('\') no longer escapes.
For about a decade, the backslash character has no longer had a
special escape syntax in Fortran F90. To get the old behaviour back,
@@ -2240,6 +2304,46 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
* Lisp Changes in Emacs 28.1
++++
+** New forms to declare how completion should happen has been added.
+'(declare (completion PREDICATE))' can be used as a general predicate
+to say whether the command should be present when completing with
+'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand
+way of saying that the command should be present when completing from
+buffers in major modes derived from MODE..., or, if it's a minor mode,
+whether that minor mode is enabled in the current buffer.
+
++++
+** The 'interactive' syntax has been extended to allow listing applicable
modes.
+Forms like '(interactive "p" dired-mode)' can be used to annotate the
+commands as being applicable for modes derived from 'dired-mode',
+or if the mode is a minor mode, that the current buffer has that
+minor mode activated. Note that using this form will create byte code
+that is not compatible with byte code in previous Emacs versions.
+
++++
+** New buffer-local variable 'local-minor-modes'.
+This permanently buffer-local variable holds a list of currently
+enabled non-global minor modes in the current buffer (as a list of
+symbols).
+
++++
+** New variable 'global-minor-modes'.
+This variable holds a list of currently enabled global minor modes (as
+a list of symbols).
+
++++
+** 'define-minor-mode' now takes an :interactive argument.
+This can be used for specifying which modes this minor mode is meant
+for, or to make the new minor mode non-interactive. The default value
+is t.
+
++++
+** 'define-derived-mode' now takes an :interactive argument.
+This can be used to control whether the defined mode is a command
+or not, and is useful when defining commands that aren't meant to be
+used by users directly.
+
** The 'values' variable is now obsolete.
---
@@ -2536,6 +2640,12 @@ locales. They are also available as aliases
'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
+** The JSON functions 'json-serialize', 'json-insert',
+'json-parse-string', and 'json-parse-buffer' now implement some of the
+semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
+these functions now accept top-level JSON values that are neither
+arrays nor objects.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2f4bab1..7111ae6 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -950,6 +950,12 @@ if `inhibit-field-text-motion' is non-nil."
;; Richard said that we should not use C-x <uppercase letter> and I have
;; no idea whereas to bind it. Any suggestion welcome. -stef
;; (define-key ctl-x-map "U" 'undo-only)
+(defvar undo-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "u" 'undo)
+ map)
+ "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
+(put 'undo 'repeat-map 'undo-repeat-map)
(define-key esc-map "!" 'shell-command)
(define-key esc-map "|" 'shell-command-on-region)
@@ -1036,6 +1042,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "`" 'next-error)
+(defvar next-error-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "n" 'next-error)
+ (define-key map "\M-n" 'next-error)
+ (define-key map "p" 'previous-error)
+ (define-key map "\M-p" 'previous-error)
+ map)
+ "Keymap to repeat next-error key sequences. Used in `repeat-mode'.")
+(put 'next-error 'repeat-map 'next-error-repeat-map)
+(put 'previous-error 'repeat-map 'next-error-repeat-map)
+
(defvar goto-map (make-sparse-keymap)
"Keymap for navigation commands.")
(define-key esc-map "g" goto-map)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index dcf8ff0..98797a0 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -953,7 +953,7 @@ When you have finished composing, type
\\[bookmark-send-edited-annotation].
(defun bookmark-send-edited-annotation ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
- (interactive)
+ (interactive nil bookmark-edit-annotation-mode)
(if (not (derived-mode-p 'bookmark-edit-annotation-mode))
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
@@ -1040,6 +1040,14 @@ it to the name of the bookmark currently being set,
advancing
(car dired-directory)))
(t (error "Buffer not visiting a file or directory")))))
+(defvar bookmark--watch-already-asked-mtime nil
+ "Mtime for which we already queried about reloading.")
+
+(defun bookmark--watch-file-already-queried-p (new-mtime)
+ ;; Don't ask repeatedly if user already said "no" to reloading a
+ ;; file with this mtime:
+ (prog1 (equal new-mtime bookmark--watch-already-asked-mtime)
+ (setq bookmark--watch-already-asked-mtime new-mtime)))
(defun bookmark-maybe-load-default-file ()
"If bookmarks have not been loaded from the default place, load them."
@@ -1048,13 +1056,15 @@ it to the name of the bookmark currently being set,
advancing
(file-readable-p bookmark-default-file)
(bookmark-load bookmark-default-file t t)))
((and bookmark-watch-bookmark-file
- (not (equal (nth 5 (file-attributes
- (car bookmark-bookmarks-timestamp)))
- (cdr bookmark-bookmarks-timestamp)))
- (or (eq 'silent bookmark-watch-bookmark-file)
- (yes-or-no-p
- (format "Bookmarks %s changed on disk. Reload? "
- (car bookmark-bookmarks-timestamp)))))
+ (let ((new-mtime (nth 5 (file-attributes
+ (car bookmark-bookmarks-timestamp))))
+ (old-mtime (cdr bookmark-bookmarks-timestamp)))
+ (and (not (equal new-mtime old-mtime))
+ (not (bookmark--watch-file-already-queried-p new-mtime))
+ (or (eq 'silent bookmark-watch-bookmark-file)
+ (yes-or-no-p
+ (format "Bookmarks %s changed on disk. Reload? "
+ (car bookmark-bookmarks-timestamp)))))))
(bookmark-load (car bookmark-bookmarks-timestamp) t t))))
(defun bookmark-maybe-sort-alist ()
@@ -1827,7 +1837,7 @@ This is used for `tabulated-list-format' in
`bookmark-bmenu-mode'."
(defun bookmark-bmenu-toggle-filenames (&optional show)
"Toggle whether filenames are shown in the bookmark list.
Optional argument SHOW means show them unconditionally."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(cond
(show
(setq bookmark-bmenu-toggle-filenames t))
@@ -1912,14 +1922,14 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag ">" t))
(defun bookmark-bmenu-mark-all ()
"Mark all listed bookmarks to be displayed by
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -1930,7 +1940,7 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
You can mark bookmarks with the
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(others ())
@@ -1975,7 +1985,7 @@ You can mark bookmarks with the
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mar
(defun bookmark-bmenu-save ()
"Save the current list into a bookmark file.
With a prefix arg, prompts for a file to save them in."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(save-window-excursion
(call-interactively 'bookmark-save)
@@ -1984,7 +1994,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-load ()
"Load the bookmark file and rebuild the bookmark menu-buffer."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(save-excursion
(save-window-excursion
@@ -1994,7 +2004,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-1-window ()
"Select this line's bookmark, alone, in full frame."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark))
(bury-buffer (other-buffer))
(delete-other-windows))
@@ -2002,7 +2012,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-2-window ()
"Select this line's bookmark, with previous buffer in second window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(pop-up-windows t))
@@ -2014,20 +2024,20 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-this-window ()
"Select this line's bookmark in this window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark)))
(defun bookmark-bmenu-other-window ()
"Select this line's bookmark in other window, leaving bookmark menu visible."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark--jump-via bookmark 'switch-to-buffer-other-window)))
(defun bookmark-bmenu-other-frame ()
"Select this line's bookmark in other frame."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(pop-up-frames t))
(bookmark-jump-other-window bookmark)))
@@ -2035,7 +2045,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-switch-other-window ()
"Make the other window select this line's bookmark.
The current window remains selected."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(fun (lambda (b) (display-buffer b t))))
(bookmark--jump-via bookmark fun)))
@@ -2044,7 +2054,7 @@ The current window remains selected."
"Jump to bookmark at mouse EVENT position in other window.
Move point in menu buffer to the position of EVENT and leave
bookmark menu visible."
- (interactive "e")
+ (interactive "e" bookmark-bmenu-mode)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
@@ -2053,20 +2063,20 @@ bookmark menu visible."
(defun bookmark-bmenu-show-annotation ()
"Show the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-show-annotation bookmark)))
(defun bookmark-bmenu-show-all-annotations ()
"Show the annotation for all bookmarks in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-show-all-annotations))
(defun bookmark-bmenu-edit-annotation ()
"Edit the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-edit-annotation bookmark t)))
@@ -2074,7 +2084,7 @@ bookmark menu visible."
(defun bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
- (interactive "P")
+ (interactive "P" bookmark-bmenu-mode)
;; any flags to reset according to circumstances? How about a
;; flag indicating whether this bookmark is being visited?
;; well, we don't have this now, so maybe later.
@@ -2085,7 +2095,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(forward-line -1)
(bookmark-bmenu-ensure-position)
(bookmark-bmenu-unmark)
@@ -2095,7 +2105,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-unmark-all ()
"Cancel all requested operations on all listed bookmarks."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -2106,7 +2116,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag "D" t))
@@ -2114,7 +2124,7 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-delete-backwards ()
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-delete)
(forward-line -2))
@@ -2123,7 +2133,7 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
"Mark all listed bookmarks as to be deleted.
To remove all deletion marks, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all].
To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -2133,7 +2143,7 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-execute-deletions ()
"Delete bookmarks flagged `D'."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((reporter (make-progress-reporter "Deleting bookmarks..."))
(o-point (point))
(o-str (save-excursion
@@ -2160,7 +2170,7 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-rename ()
"Rename bookmark on current line. Prompts for a new name."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-rename bmrk)
@@ -2169,14 +2179,14 @@ To carry out the deletions that you've marked, use
\\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-locate ()
"Display location of this bookmark. Displays in the minibuffer."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark)))
(message "%s" (bookmark-location bmrk))))
(defun bookmark-bmenu-relocate ()
"Change the absolute file name of the bookmark on the current line.
Prompt with completion for the new path."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-relocate bmrk)
@@ -2196,7 +2206,7 @@ Prompt with completion for the new path."
;;;###autoload
(defun bookmark-bmenu-search ()
"Incremental search of bookmarks, hiding the non-matches as we go."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmk (bookmark-bmenu-bookmark))
(timer nil))
(unwind-protect
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index bb39e1f..6df935f 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -268,6 +268,7 @@ In Buffer Menu mode, the following commands are defined:
\\[revert-buffer] Update the list of buffers.
\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only
file buffers.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
+ :interactive nil
(setq-local buffer-stale-function
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
@@ -328,7 +329,7 @@ ARG, show only buffers that are visiting files."
"Toggle whether the current buffer-menu displays only file buffers.
With a positive ARG, display only file buffers. With zero or
negative ARG, display other buffers as well."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(setq Buffer-menu-files-only
(cond ((not arg) (not Buffer-menu-files-only))
((> (prefix-numeric-value arg) 0) t)))
@@ -337,7 +338,8 @@ negative ARG, display other buffers as well."
"Showing all non-internal buffers."))
(revert-buffer))
-(defalias 'Buffer-menu-sort 'tabulated-list-sort)
+(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort
+ "28.1")
(defun Buffer-menu-buffer (&optional error-if-non-existent-p)
@@ -373,14 +375,14 @@ is nil or omitted, and signal an error otherwise."
(defun Buffer-menu-mark ()
"Mark the Buffer menu entry at point for later display.
It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select]
command."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t)
(forward-line))
(defun Buffer-menu-unmark (&optional backup)
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(Buffer-menu--unmark)
(forward-line (if backup -1 1)))
@@ -388,7 +390,7 @@ Optional prefix arg means move up."
"Cancel a requested operation on all buffers.
MARK is the character to flag the operation on the buffers.
When called interactively prompt for MARK; RET remove all marks."
- (interactive "cRemove marks (RET means all):")
+ (interactive "cRemove marks (RET means all):" Buffer-menu-mode)
(save-excursion
(goto-char (point-min))
(when (tabulated-list-header-overlay-p)
@@ -403,12 +405,12 @@ When called interactively prompt for MARK; RET remove
all marks."
(defun Buffer-menu-unmark-all ()
"Cancel all requested operations on buffers."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(Buffer-menu-unmark-all-buffers ?\r))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(forward-line -1)
(Buffer-menu--unmark))
@@ -427,7 +429,7 @@ will delete it.
If prefix argument ARG is non-nil, it specifies the number of
buffers to delete; a negative ARG means to delete backwards."
- (interactive "p")
+ (interactive "p" Buffer-menu-mode)
(if (or (null arg) (= arg 0))
(setq arg 1))
(while (> arg 0)
@@ -446,14 +448,14 @@ buffers to delete; a negative ARG means to delete
backwards."
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]'
command will delete the marked buffer. Prefix ARG means move
that many lines."
- (interactive "p")
+ (interactive "p" Buffer-menu-mode)
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
"Mark the buffer on this Buffer Menu line for saving.
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
will save it."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(when (Buffer-menu-buffer)
(tabulated-list-set-col 2 "S" t)
(forward-line 1)))
@@ -462,7 +464,7 @@ will save it."
"Mark the buffer on this line as unmodified (no changes to save).
If ARG is non-nil (interactively, with a prefix argument), mark
it as modified."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
(tabulated-list-set-col 2 (if arg "*" " ") t))
@@ -471,7 +473,7 @@ it as modified."
"Save and/or delete marked buffers in the Buffer Menu.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are
deleted."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
@@ -502,7 +504,7 @@ You can mark buffers with the
\\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' com
This command deletes and replaces all the previously existing windows
in the selected frame, and will remove any marks."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
(others (delq this-buffer (Buffer-menu-marked-buffers t)))
@@ -533,23 +535,23 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-isearch-buffers ()
"Search for a string through all marked buffers using Isearch."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(multi-isearch-buffers (Buffer-menu-marked-buffers)))
(defun Buffer-menu-isearch-buffers-regexp ()
"Search for a regexp through all marked buffers using Isearch."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(multi-isearch-buffers-regexp (Buffer-menu-marked-buffers)))
(defun Buffer-menu-multi-occur (regexp &optional nlines)
"Show all lines in marked buffers containing a match for a regexp."
- (interactive (occur-read-primary-args))
+ (interactive (occur-read-primary-args) Buffer-menu-mode)
(multi-occur (Buffer-menu-marked-buffers) regexp nlines))
(defun Buffer-menu-visit-tags-table ()
"Visit the tags table in the buffer on this line. See `visit-tags-table'."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((file (buffer-file-name (Buffer-menu-buffer t))))
(if file
(visit-tags-table file)
@@ -557,30 +559,30 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-1-window ()
"Select this line's buffer, alone, in full frame."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t))
(bury-buffer (other-buffer))
(delete-other-windows))
(defun Buffer-menu-this-window ()
"Select this line's buffer in this window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-other-window ()
"Select this line's buffer in other window, leaving buffer menu visible."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer-other-window (Buffer-menu-buffer t)))
(defun Buffer-menu-switch-other-window ()
"Make the other window select this line's buffer.
The current window remains selected."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(display-buffer (Buffer-menu-buffer t) t))
(defun Buffer-menu-2-window ()
"Select this line's buffer, with previous buffer in second window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((buff (Buffer-menu-buffer t))
(menu (current-buffer)))
(delete-other-windows)
@@ -591,7 +593,7 @@ The current window remains selected."
(defun Buffer-menu-toggle-read-only ()
"Toggle read-only status of buffer on this line.
This behaves like invoking \\[read-only-mode] in that buffer."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((read-only
(with-current-buffer (Buffer-menu-buffer t)
(read-only-mode 'toggle)
@@ -600,7 +602,7 @@ This behaves like invoking \\[read-only-mode] in that
buffer."
(defun Buffer-menu-bury ()
"Bury the buffer listed on this line."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((buffer (tabulated-list-get-id)))
(cond ((null buffer))
((buffer-live-p buffer)
@@ -616,12 +618,12 @@ This behaves like invoking \\[read-only-mode] in that
buffer."
(defun Buffer-menu-view ()
"View this line's buffer in View mode."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(view-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-view-other-window ()
"View this line's buffer in View mode in another window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(view-buffer-other-window (Buffer-menu-buffer t)))
;;; Functions for populating the Buffer Menu.
@@ -646,7 +648,7 @@ means list those buffers and no others."
(defun Buffer-menu-mouse-select (event)
"Select the buffer whose line you click on."
- (interactive "e")
+ (interactive "e" Buffer-menu-mode)
(select-window (posn-window (event-end event)))
(let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
(when (buffer-live-p buffer)
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index 2b317ac..18fd483 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -486,8 +486,8 @@
(defun calc-replace-sub-formula (expr rsf-old rsf-new)
(let ((calc-rsf-old rsf-old)
- (calc-rsf-new (calc-encase-atoms rsf-new))))
- (calc-replace-sub-formula-rec expr))
+ (calc-rsf-new (calc-encase-atoms rsf-new)))
+ (calc-replace-sub-formula-rec expr)))
(defun calc-replace-sub-formula-rec (expr)
(cond ((eq expr calc-rsf-old) calc-rsf-new)
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 1d7de4a..dafdd41 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -889,12 +889,14 @@ If DAY-SHIFT is non-nil, the result is shifted by
DAY-SHIFT days."
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
-(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
+(defun icalendar--datestring-to-isodate (datestring &optional day-shift
year-shift)
"Convert diary-style DATESTRING to iso-style date.
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
--- DAY-SHIFT must be either nil or an integer. This function
-tries to figure the date style from DATESTRING itself. If that
-is not possible it uses the current calendar date style."
+-- DAY-SHIFT must be either nil or an integer. If YEAR-SHIFT is
+non-nil, the result is shifted by YEAR-SHIFT years -- YEAR-SHIFT
+must be either nil or an integer. This function tries to figure
+the date style from DATESTRING itself. If that is not possible
+it uses the current calendar date style."
(let ((day -1) month year)
(save-match-data
(cond ( ;; iso-style numeric date
@@ -904,7 +906,7 @@ is not possible it uses the current calendar date style."
"0?\\([1-9][0-9]?\\)")
datestring)
(setq year (read (substring datestring (match-beginning 1)
- (match-end 1))))
+ (match-end 1))))
(setq month (read (substring datestring (match-beginning 2)
(match-end 2))))
(setq day (read (substring datestring (match-beginning 3)
@@ -967,6 +969,9 @@ is not possible it uses the current calendar date style."
(match-end 3)))))
(t
nil)))
+ (when year-shift
+ (setq year (+ year year-shift)))
+
(if (> day 0)
(let ((mdy (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian (list month day
@@ -1916,9 +1921,9 @@ entries. ENTRY-MAIN is the first line of the diary
entry."
(let* ((datetime (substring entry-main (match-beginning 1)
(match-end 1)))
(startisostring (icalendar--datestring-to-isodate
- datetime))
+ datetime nil 1))
(endisostring (icalendar--datestring-to-isodate
- datetime 1))
+ datetime 1 1))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
@@ -2402,8 +2407,11 @@ END-T is the event's end time in diary format."
(if end-t "-" "")
(or end-t ""))))
(setq result (format
- "%%%%(and (diary-anniversary %s)) %s%s%s"
- dtstart-conv
+ "%%%%(diary-anniversary %s) %s%s%s"
+ (let* ((year (nth 5 dtstart-dec))
+ (dtstart-1y-dec (copy-sequence dtstart-dec)))
+ (setf (nth 5 dtstart-1y-dec) (1- year))
+ (icalendar--datetime-to-diary-date
dtstart-1y-dec))
(or start-t "")
(if end-t "-" "") (or end-t "")))))
;; monthly
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 810d6ef..3fcc023 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,4 +1,4 @@
-;;; ede/base.el --- Baseclasses for EDE.
+;;; ede/base.el --- Baseclasses for EDE -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -288,7 +288,7 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(unless (symbolp obj)
(message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
`(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
@@ -317,13 +317,15 @@ If set to nil, then the cache is not saved."
(defvar ede-project-cache-files nil
"List of project files EDE has seen before.")
+(defvar recentf-exclude)
+
(defun ede-save-cache ()
"Save a cache of EDE objects that Emacs has seen before."
(interactive)
(when ede-project-placeholder-cache-file
(let ((p ede-projects)
(c ede-project-cache-files)
- (recentf-exclude '( (lambda (f) t) ))
+ (recentf-exclude `( ,(lambda (_) t) ))
)
(condition-case nil
(progn
@@ -461,7 +463,7 @@ Not all buffers need headers, so return nil if no
applicable."
(ede-buffer-header-file ede-object (current-buffer))
nil))
-(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
+(cl-defmethod ede-buffer-header-file ((_this ede-project) _buffer)
"Return nil, projects don't have header files."
nil)
@@ -487,12 +489,12 @@ Some projects may have multiple documentation files, so
return a list."
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
-(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-project) _buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
-(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
+(cl-defmethod ede-buffer-documentation-files ((_this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
@@ -518,7 +520,7 @@ files in the project."
proj (cdr proj)))
found))
-(cl-defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((_this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -529,7 +531,7 @@ files in the project."
(ede-html-documentation (ede-toplevel))
)
-(cl-defmethod ede-html-documentation ((this ede-project))
+(cl-defmethod ede-html-documentation ((_this ede-project))
"Return a list of HTML files provided by project THIS."
)
@@ -636,18 +638,7 @@ PROJECT-FILE-NAME is a name of project file (short name,
like `pom.xml', etc."
(oset this directory (file-name-directory (oref this file))))
)
-
-
-;;; Hooks & Autoloads
-;;
-;; These let us watch various activities, and respond appropriately.
-
-;; (add-hook 'edebug-setup-hook
-;; (lambda ()
-;; (def-edebug-spec ede-with-projectfile
-;; (form def-body))))
-
(provide 'ede/base)
;; Local variables:
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index c85d4ee..7eb42ed 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,4 +1,4 @@
-;;; ede/dired.el --- EDE extensions to dired.
+;;; ede/dired.el --- EDE extensions to dired. -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index 1eb4c63..00496ac 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,4 +1,4 @@
-;;; ede/emacs.el --- Special project for Emacs
+;;; ede/emacs.el --- Special project for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -54,31 +54,6 @@ Return a tuple of ( EMACSNAME . VERSION )."
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
(cond
- ;; Maybe XEmacs?
- ((file-exists-p "version.sh")
- (setq emacs "XEmacs")
- (insert-file-contents "version.sh")
- (goto-char (point-min))
- (re-search-forward "emacs_major_version=\\([0-9]+\\)
-emacs_minor_version=\\([0-9]+\\)
-emacs_beta_version=\\([0-9]+\\)")
- (setq ver (concat (match-string 1) "."
- (match-string 2) "."
- (match-string 3)))
- )
- ((file-exists-p "sxemacs.pc.in")
- (setq emacs "SXEmacs")
- (insert-file-contents "sxemacs_version.m4")
- (goto-char (point-min))
- (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\],
\\[\\([0-9]+\\)\\])
-m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\])
-m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
- (setq ver (concat (match-string 1) "."
- (match-string 2) "."
- (match-string 3)))
- )
- ;; Insert other Emacs here...
-
;; Vaguely recent version of GNU Emacs?
((or (file-exists-p configure_ac)
(file-exists-p (setq configure_ac "configure.in")))
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index 863d715..4f86558 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,4 +1,4 @@
-;;; ede/make.el --- General information about "make"
+;;; ede/make.el --- General information about "make" -*- lexical-binding: t
-*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 4c948df..e1fe856 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,4 +1,4 @@
-;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
+;;; ede-pmake.el --- EDE Generic Project Makefile code generator -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
@@ -241,6 +241,7 @@ MFILENAME is the makefile to generate."
(defmacro ede-pmake-insert-variable-shared (varname &rest body)
"Add VARNAME into the current Makefile.
Execute BODY in a location where a value can be placed."
+ (declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(if (save-excursion
(goto-char (point-max))
@@ -258,11 +259,11 @@ Execute BODY in a location where a value can be placed."
,@body
(if addcr (insert "\n"))
(goto-char (point-max))))
-(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1)
(defmacro ede-pmake-insert-variable-once (varname &rest body)
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
+ (declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(unless
(save-excursion
@@ -271,7 +272,6 @@ Execute BODY in a location where a value can be placed."
,@body
(when addcr (insert "\n"))
(goto-char (point-max)))))
-(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1)
;;; SOURCE VARIABLE NAME CONSTRUCTION
@@ -289,7 +289,7 @@ Change . to _ in the variable name."
;;; DEPENDENCY FILE GENERATOR LISTS
;;
-(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-dependency-files ((_this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
@@ -302,7 +302,7 @@ Argument THIS is the target to get sources from."
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables-new ((_this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
@@ -420,7 +420,7 @@ Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
(cl-defmethod ede-proj-makefile-insert-variables ((this
ede-proj-target-makefile)
- &optional moresource)
+ &optional _moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
@@ -449,12 +449,12 @@ sources variable."
(ede-proj-makefile-insert-variables linker)))))
(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
- ((this ede-proj-target))
+ ((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
(cl-defmethod ede-proj-makefile-insert-automake-post-variables
- ((this ede-proj-target))
+ ((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
@@ -511,7 +511,7 @@ Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
-(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this
ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((_this
ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
@@ -530,7 +530,7 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj))
))))
-(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this
ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-extradist ((_this
ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
@@ -602,7 +602,7 @@ Argument THIS is the target that should insert stuff."
"\t@false\n\n"
"\n\n# End of Makefile\n")))
-(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-rules ((_this ede-proj-target))
"Insert rules needed by THIS target."
nil)
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 038f994..9da6374 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,4 +1,4 @@
-;;; ede/proj-archive.el --- EDE Generic Project archive support
+;;; ede/proj-archive.el --- EDE Generic Project archive support -*-
lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc.
@@ -45,7 +45,7 @@
"Linker object for creating an archive.")
(cl-defmethod ede-proj-makefile-insert-source-variables :before
- ((this ede-proj-target-makefile-archive) &optional moresource)
+ ((this ede-proj-target-makefile-archive) &optional _moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
Makefile.am generator, so use it to add this important bin program."
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index f5bcebd..7325955 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,4 +1,4 @@
-;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
+;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support -*-
lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 26aa668..ba52784 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,4 +1,4 @@
-;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
+;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver -*-
lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software
;; Foundation, Inc.
@@ -172,12 +172,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
-(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-compiler) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
-(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-linker) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
@@ -185,11 +185,13 @@ rules from being created.")
(defmacro ede-compiler-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
+ (declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-compiler-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
+ (declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
@@ -198,25 +200,18 @@ This will prevent rules from creating duplicate variables
or rules."
(defmacro ede-linker-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
+ (declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-linker-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
+ (declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
,@body)))
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec ede-compiler-begin-unique def-body)
- (def-edebug-spec ede-compiler-only-once (form def-body))
- (def-edebug-spec ede-linker-begin-unique def-body)
- (def-edebug-spec ede-linker-only-once (form def-body))
- (def-edebug-spec ede-pmake-insert-variable-shared (form def-body))
- ))
-
;;; Queries
(defun ede-proj-find-compiler (compilers sourcetype)
"Return a compiler from the list COMPILERS that will compile SOURCETYPE."
@@ -246,7 +241,7 @@ This will prevent rules from creating duplicate variables
or rules."
)
(oref this autoconf)))
-(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-flush-autoconf ((_this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
@@ -281,8 +276,8 @@ If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
- targetname)
+(cl-defmethod ede-compiler-intermediate-object-variable ((_this ede-compiler)
+ targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
@@ -343,16 +338,6 @@ compiler it decides to use after inserting in the rule."
commands))
(insert "\n")))
-;;; Some details about our new macro
-;;
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec ede-compiler-begin-unique def-body)))
-(put 'ede-compiler-begin-unique 'lisp-indent-function 0)
-(put 'ede-compiler-only-once 'lisp-indent-function 1)
-(put 'ede-linker-begin-unique 'lisp-indent-function 0)
-(put 'ede-linker-only-once 'lisp-indent-function 1)
-
(provide 'ede/proj-comp)
;;; ede/proj-comp.el ends here
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index 70132af..068e998 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,4 +1,4 @@
-;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
+;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support -*-
lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 51844af..b0e2878 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,4 +1,4 @@
-;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
+;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support -*-
lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
)
"This target consists of scheme files.")
-(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
+(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index 5dd0a7e..dd009bf 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,4 +1,4 @@
-;;; ede/srecode.el --- EDE utilities on top of SRecoder
+;;; ede/srecode.el --- EDE utilities on top of SRecoder -*- lexical-binding:
t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -86,7 +86,6 @@ Note: Just like `srecode-insert', but templates found in
`ede' app."
(car (cdr dictionary-entries)))
(setq dictionary-entries
(cdr (cdr dictionary-entries))))
-
))
(provide 'ede/srecode)
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index d83d6d1..8ef38f0 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,4 +1,4 @@
-;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
+;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) -*-
lexical-binding: t -*-
;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/bovine/gcc.el
b/lisp/cedet/semantic/bovine/gcc.el
index 9cd9cdc..c2121e5 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -89,8 +89,9 @@ to give to the program."
(let ((path (substring line 1)))
(when (and (file-accessible-directory-p path)
(file-name-absolute-p path))
- (cl-pushnew (expand-file-name path) inc-path))))))))
- inc-path))
+ (cl-pushnew (expand-file-name path) inc-path
+ :test #'equal))))))))
+ (nreverse inc-path)))
(defun semantic-cpp-defs (str)
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index 8d5b5dc..17ffaef 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,4 +1,4 @@
-;;; semantic/ctxt.el --- Context calculations for Semantic tools.
+;;; semantic/ctxt.el --- Context calculations for Semantic tools -*-
lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -137,18 +137,16 @@ Return non-nil if there is no upper context."
(defmacro semantic-with-buffer-narrowed-to-context (&rest body)
"Execute BODY with the buffer narrowed to the current context."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-context)
,@body))
-(put 'semantic-with-buffer-narrowed-to-context 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-context
- (def-body))))
;;; Local Variables
;;
-;;
+
+(defvar semantic--progress-reporter)
+
(define-overloadable-function semantic-get-local-variables (&optional point)
"Get the local variables based on POINT's context.
Local variables are returned in Semantic tag format.
@@ -345,14 +343,10 @@ beginning and end of a command."
(defmacro semantic-with-buffer-narrowed-to-command (&rest body)
"Execute BODY with the buffer narrowed to the current command."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-command)
,@body))
-(put 'semantic-with-buffer-narrowed-to-command 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-command
- (def-body))))
(define-overloadable-function semantic-ctxt-end-of-symbol (&optional point)
"Move point to the end of the current symbol under POINT.
@@ -374,7 +368,7 @@ work on C like languages."
;; NOTE: The [ \n] expression below should used \\s-, but that
;; doesn't work in C since \n means end-of-comment, and isn't
;; really whitespace.
- (fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[
\t\n\r]*\\(\\w\\|\\s_\\)"))
+ ;;(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[
\t\n\r]*\\(\\w\\|\\s_\\)"))
(case-fold-search semantic-case-fold)
(continuesearch t)
(end nil)
@@ -655,7 +649,7 @@ POINT defaults to the value of point in current buffer.
You should override this function in multiple mode buffers to
determine which major mode apply at point.")
-(defun semantic-ctxt-current-mode-default (&optional point)
+(defun semantic-ctxt-current-mode-default (&optional _point)
"Return the major mode active at POINT.
POINT defaults to the value of point in current buffer.
This default implementation returns the current major mode."
@@ -671,7 +665,7 @@ The return value can be a mixed list of either strings
(names of
types that are in scope) or actual tags (type declared locally
that may or may not have a name.)")
-(defun semantic-ctxt-scoped-types-default (&optional point)
+(defun semantic-ctxt-scoped-types-default (&optional _point)
"Return a list of scoped types by name for the current context at POINT.
This is very different for various languages, and does nothing unless
overridden."
diff --git a/lisp/cedet/semantic/decorate/include.el
b/lisp/cedet/semantic/decorate/include.el
index ee7fad1..851a2c4 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,4 +1,4 @@
-;;; semantic/decorate/include.el --- Decoration modes for include statements
+;;; semantic/decorate/include.el --- Decoration modes for include statements
-*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -535,7 +535,7 @@ Argument EVENT is the mouse clicked event."
(interactive)
(let* ((tag (semantic-current-tag))
(table (semanticdb-find-table-for-include tag (current-buffer)))
- (mm major-mode))
+ ) ;; (mm major-mode)
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-fileless-include-describe)
(called-interactively-p 'interactive))
@@ -793,7 +793,7 @@ any decorated referring includes.")
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
(semanticdb-notify-references
- table (lambda (tab me)
+ table (lambda (tab _me)
(semantic-decoration-unparsed-include-refrence-reset tab)
))
))
@@ -805,7 +805,7 @@ any decorated referring includes.")
(semantic-reset cache)))
(cl-defmethod semanticdb-synchronize ((cache
semantic-decoration-unparsed-include-cache)
- new-tags)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
diff --git a/lisp/cedet/semantic/decorate/mode.el
b/lisp/cedet/semantic/decorate/mode.el
index 884b066..89cc930 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,4 +1,4 @@
-;;; semantic/decorate/mode.el --- Minor mode for decorating tags
+;;; semantic/decorate/mode.el --- Minor mode for decorating tags -*-
lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@@ -358,12 +358,12 @@ Return non-nil if the decoration style is enabled."
:selected `(semantic-decoration-style-enabled-p ,(car style))
))
-(defun semantic-build-decoration-mode-menu (&rest ignore)
+(defun semantic-build-decoration-mode-menu (&rest _ignore)
"Create a menu listing all the known decorations for toggling.
IGNORE any input arguments."
(or semantic-decoration-menu-cache
(setq semantic-decoration-menu-cache
- (mapcar 'semantic-decoration-build-style-menu
+ (mapcar #'semantic-decoration-build-style-menu
(reverse semantic-decoration-styles))
)))
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 408011c..5675b9f 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,4 +1,4 @@
-;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
+;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor -*-
lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -106,22 +106,12 @@ added and removed from this symbol table.")
Pushes NAME into the macro stack. The above stack is checked
by `semantic-lex-spp-symbol' to not return true for any symbol
currently being expanded."
+ (declare (indent 1) (debug (symbolp def-body)))
`(unwind-protect
(progn
(push ,name semantic-lex-spp-expanded-macro-stack)
,@body)
(pop semantic-lex-spp-expanded-macro-stack)))
-(put 'semantic-lex-with-macro-used 'lisp-indent-function 1)
-
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec semantic-lex-with-macro-used
- (symbolp def-body)
- )
-
- ))
;;; MACRO TABLE UTILS
;;
@@ -190,7 +180,7 @@ Disable debugging by entering nothing."
(setq semantic-lex-spp-debug-symbol nil)
(setq semantic-lex-spp-debug-symbol sym)))
-(defmacro semantic-lex-spp-validate-value (name value)
+(defmacro semantic-lex-spp-validate-value (_name _value)
"Validate the NAME and VALUE of a macro before it is set."
; `(progn
; (when (not (semantic-lex-spp-value-valid-p ,value))
@@ -212,12 +202,11 @@ the dynamic map."
(semantic-lex-spp-dynamic-map)))
value))
-(defsubst semantic-lex-spp-symbol-remove (name &optional obarray)
+(defsubst semantic-lex-spp-symbol-remove (name &optional map)
"Remove the spp symbol with NAME.
-If optional OBARRAY is non-nil, then use that obarray instead of
+If optional obarray MAP is non-nil, then use that obarray instead of
the dynamic map."
- (unintern name (or obarray
- (semantic-lex-spp-dynamic-map))))
+ (unintern name (or map (semantic-lex-spp-dynamic-map))))
(defun semantic-lex-spp-symbol-push (name value)
"Push macro NAME with VALUE into the map.
@@ -246,7 +235,7 @@ Reverse with `semantic-lex-spp-symbol-pop'."
(stack (semantic-lex-spp-dynamic-map-stack))
(mapsym (intern name map))
(stacksym (intern name stack))
- (oldvalue nil)
+ ;; (oldvalue nil)
)
(if (or (not (boundp stacksym) )
(= (length (symbol-value stacksym)) 0))
@@ -324,7 +313,7 @@ For use with semanticdb restoration of state."
;; Default obarray for below is the dynamic map.
(semantic-lex-spp-symbol-set (car e) (cdr e))))
-(defun semantic-lex-spp-reset-hook (start end)
+(defun semantic-lex-spp-reset-hook (start _end)
"Reset anything needed by SPP for parsing.
In this case, reset the dynamic macro symbol table if
START is (point-min).
@@ -354,7 +343,7 @@ Return non-nil if it matches"
(string-match regex value))
))
-(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues)
+(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end _argvalues)
"Convert lexical macro contents VAL into a macro expansion stream.
These are for simple macro expansions that a user may have typed in directly.
As such, we need to analyze the input text, to figure out what kind of real
@@ -819,7 +808,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
-(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
+(defun semantic-lex-spp-analyzer-do-replace (_sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@@ -1045,7 +1034,7 @@ and variable state from the current buffer."
(fresh-toks nil)
(toks nil)
(origbuff (current-buffer))
- (analyzer semantic-lex-analyzer)
+ ;; (analyzer semantic-lex-analyzer)
(important-vars '(semantic-lex-spp-macro-symbol-obarray
semantic-lex-spp-project-macro-symbol-obarray
semantic-lex-spp-dynamic-macro-symbol-obarray
@@ -1176,6 +1165,7 @@ of type `spp-macro-def' is to be created.
VALFORM are forms that return the value to be saved for this macro, or nil.
When implementing a macro, you can use `semantic-lex-spp-stream-for-macro'
to convert text into a lexical stream for storage in the macro."
+ (declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@@ -1209,6 +1199,7 @@ REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
of type `spp-macro-undef' is to be created."
+ (declare (debug (&define name stringp stringp form)))
(let ((start (make-symbol "start"))
(end (make-symbol "end")))
`(define-lex-regex-analyzer ,name
@@ -1244,7 +1235,7 @@ Note: Not implemented yet."
:group 'semantic
:type 'boolean)
-(defun semantic-lex-spp-merge-header (name)
+(defun semantic-lex-spp-merge-header (_name)
"Extract and merge any macros from the header with NAME.
Finds the header file belonging to NAME, gets the macros
from that file, and then merge the macros with our current
@@ -1269,6 +1260,7 @@ type of include. The return value should be of the form:
(NAME . TYPE)
where NAME is the name of the include, and TYPE is the type of the include,
where a valid symbol is `system', or nil."
+ (declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@@ -1369,23 +1361,6 @@ If BUFFER is not provided, use the current buffer."
(princ "\n")
))))
-;;; EDEBUG Handlers
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-lex-spp-macro-declaration-analyzer
- (&define name stringp stringp form def-body)
- )
-
- (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer
- (&define name stringp stringp form)
- )
-
- (def-edebug-spec define-lex-spp-include-analyzer
- (&define name stringp stringp form def-body))))
-
(provide 'semantic/lex-spp)
;; Local variables:
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index ae70d5c..b3399aa 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -760,6 +760,7 @@ If two analyzers can match the same text, it is important
to order the
analyzers so that the one you want to match first occurs first. For
example, it is good to put a number analyzer in front of a symbol
analyzer which might mistake a number for a symbol."
+ (declare (debug (&define name stringp (&rest symbolp))))
`(defun ,name (start end &optional depth length)
,(concat doc "\nSee `semantic-lex' for more information.")
;; Make sure the state of block parsing starts over.
@@ -1064,14 +1065,13 @@ the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
Avoid using a large FORMS since it is duplicated."
+ (declare (indent 1) (debug t))
`(if (and debug-on-error semantic-lex-debug-analyzers)
(progn ,@forms)
(condition-case nil
(progn ,@forms)
(error
(semantic-lex-unterminated-syntax-detected ,syntax)))))
-(put 'semantic-lex-unterminated-syntax-protection
- 'lisp-indent-function 1)
(defmacro define-lex-analyzer (name doc condition &rest forms)
"Create a single lexical analyzer NAME with DOC.
@@ -1096,6 +1096,7 @@ Proper action in FORMS is to move the value of
`semantic-lex-end-point' to
after the location of the analyzed entry, and to add any discovered tokens
at the beginning of `semantic-lex-token-stream'.
This can be done by using `semantic-lex-push-token'."
+ (declare (debug (&define name stringp form def-body)))
`(eval-and-compile
(defvar ,name nil ,doc)
(defun ,name nil)
@@ -1122,6 +1123,7 @@ This can be done by using `semantic-lex-push-token'."
"Create a lexical analyzer with NAME and DOC that will match REGEXP.
FORMS are evaluated upon a successful match.
See `define-lex-analyzer' for more about analyzers."
+ (declare (debug (&define name stringp form def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1139,6 +1141,8 @@ expression.
FORMS are evaluated upon a successful match BEFORE the new token is
created. It is valid to ignore FORMS.
See `define-lex-analyzer' for more about analyzers."
+ (declare (debug
+ (&define name stringp form symbolp [ &optional form ] def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1163,6 +1167,7 @@ where BLOCK-SYM is the symbol returned in a block token.
OPEN-DELIM
and CLOSE-DELIM are respectively the open and close delimiters
identifying a block. OPEN-SYM and CLOSE-SYM are respectively the
symbols returned in open and close tokens."
+ (declare (debug (&define name stringp form (&rest form))))
(let ((specs (cons spec1 specs))
spec open olist clist)
(while specs
@@ -1684,6 +1689,7 @@ the error will be caught here without the buffer's cache
being thrown
out of date.
If there is an error, the syntax that failed is returned.
If there is no error, then the last value of FORMS is returned."
+ (declare (indent 1) (debug (symbolp def-body)))
(let ((ret (make-symbol "ret"))
(syntax (make-symbol "syntax"))
(start (make-symbol "start"))
@@ -1707,36 +1713,8 @@ If there is no error, then the last value of FORMS is
returned."
;;(message "Buffer not currently parsable (%S)." ,ret)
(semantic-parse-tree-unparseable))
,ret)))
-(put 'semantic-lex-catch-errors 'lisp-indent-function 1)
-;;; Interfacing with edebug
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-lex
- (&define name stringp (&rest symbolp))
- )
- (def-edebug-spec define-lex-analyzer
- (&define name stringp form def-body)
- )
- (def-edebug-spec define-lex-regex-analyzer
- (&define name stringp form def-body)
- )
- (def-edebug-spec define-lex-simple-regex-analyzer
- (&define name stringp form symbolp [ &optional form ] def-body)
- )
- (def-edebug-spec define-lex-block-analyzer
- (&define name stringp form (&rest form))
- )
- (def-edebug-spec semantic-lex-catch-errors
- (symbolp def-body)
- )
-
- ))
-
;;; Compatibility with Semantic 1.x lexical analysis
(defvar semantic-flex-tokens semantic-lex-tokens
diff --git a/lisp/cedet/semantic/symref/cscope.el
b/lisp/cedet/semantic/symref/cscope.el
index 3686e51..e63b7a7 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
-;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
+;;; semantic/symref/cscope.el --- Semantic-symref support via cscope -*-
lexical-binding: t; -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/filter.el
b/lisp/cedet/semantic/symref/filter.el
index a40ce13..7ef3cd9 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
+;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy
-*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -48,7 +48,7 @@
"Determine if the tag TARGET is used at POSITION in the current buffer.
Return non-nil for a match."
(semantic-analyze-current-symbol
- (lambda (start end prefix)
+ (lambda (_start _end prefix)
(let ((tag (car (nreverse prefix))))
(and (semantic-tag-p tag)
(semantic-equivalent-tag-p target tag))))
@@ -97,7 +97,7 @@ tag that contains point, and return that."
(Lcount 0))
(when (semantic-tag-p target)
(semantic-symref-hits-in-region
- target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
+ target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
(when (called-interactively-p 'interactive)
@@ -106,6 +106,8 @@ tag that contains point, and return that."
(semantic-elapsed-time start nil)))
Lcount)))
+(defvar srecode-field-archive)
+
(defun semantic-symref-rename-local-variable ()
"Fancy way to rename the local variable under point.
Depends on the SRecode Field editing API."
@@ -140,7 +142,7 @@ Depends on the SRecode Field editing API."
(region nil)
)
(semantic-symref-hits-in-region
- target (lambda (start end prefix)
+ target (lambda (start end _prefix)
;; For every valid hit, create one field.
(srecode-field "LOCAL" :name "LOCAL" :start start :end end))
(semantic-tag-start tag) (semantic-tag-end tag))
diff --git a/lisp/cedet/semantic/symref/global.el
b/lisp/cedet/semantic/symref/global.el
index 7f63e4d..23e4034 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/global.el --- Use GNU Global for symbol references
+;;; semantic/symref/global.el --- Use GNU Global for symbol references -*-
lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 9f0ac38..46027f1 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/grep.el --- Symref implementation using find/grep
+;;; semantic/symref/grep.el --- Symref implementation using find/grep -*-
lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/symref/idutils.el
b/lisp/cedet/semantic/symref/idutils.el
index 4a41355..3e3e3b0 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
-;;; semantic/symref/idutils.el --- Symref implementation for idutils
+;;; semantic/symref/idutils.el --- Symref implementation for idutils -*-
lexical-binding: t; -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/list.el
b/lisp/cedet/semantic/symref/list.el
index 7d3a5dd..50d2e2b 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/list.el --- Symref Output List UI.
+;;; semantic/symref/list.el --- Symref Output List UI -*- lexical-binding: t;
-*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 85defe4..3d7bce8 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,4 +1,4 @@
-;;; semantic/tag.el --- tag creation and access
+;;; semantic/tag.el --- Tag creation and access -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@@ -1038,25 +1038,17 @@ See `semantic-tag-bounds'."
(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
"Execute BODY with the buffer narrowed to the current tag."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-tag (semantic-current-tag))
,@body))
-(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
- (def-body))))
(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
"Narrow to TAG, and execute BODY."
+ (declare (indent 1) (debug t))
`(save-restriction
(semantic-narrow-to-tag ,tag)
,@body))
-(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-tag
- (def-body))))
;;; Tag Hooks
;;
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index d5b7324..ecd9683 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent.el --- Wisent - Semantic gateway
+;;; semantic/wisent.el --- Wisent - Semantic gateway -*- lexical-binding: t;
-*-
;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc.
@@ -69,6 +69,7 @@ Returned tokens must have the form:
(TOKSYM VALUE START . END)
where VALUE is the buffer substring between START and END positions."
+ (declare (debug (&define name stringp def-body)))
`(defun
,name () ,doc
(cond
@@ -319,18 +320,6 @@ the standard function `semantic-parse-region'."
(point-max))))))
;; Return parse tree
(nreverse ptree)))
-
-;;; Interfacing with edebug
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-wisent-lexer
- (&define name stringp def-body)
- )
-
- ))
(provide 'semantic/wisent)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index dfbbdf5..b45984b 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -141,9 +141,12 @@ expression, in which case we want to handle forms
differently."
((stringp (car-safe rest)) (car rest))))
;; Look for an interactive spec.
(interactive (pcase body
- ((or `((interactive . ,_) . ,_)
- `(,_ (interactive . ,_) . ,_))
- t))))
+ ((or `((interactive . ,iargs) . ,_)
+ `(,_ (interactive . ,iargs) . ,_))
+ ;; List of modes or just t.
+ (if (nthcdr 1 iargs)
+ (list 'quote (nthcdr 1 iargs))
+ t)))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
@@ -209,7 +212,11 @@ expression, in which case we want to handle forms
differently."
easy-mmode-define-minor-mode
define-minor-mode))
t)
- (eq (car-safe (car body)) 'interactive))
+ (and (eq (car-safe (car body)) 'interactive)
+ ;; List of modes or just t.
+ (or (if (nthcdr 1 (car body))
+ (list 'quote (nthcdr 1 (car body)))
+ t))))
,(if macrop ''macro nil))))
;; For defclass forms, use `eieio-defclass-autoload'.
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 3e1c329..ea70baa 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -190,7 +190,7 @@ This is commonly used to recompute `backtrace-frames'.")
(defvar-local backtrace-print-function #'cl-prin1
"Function used to print values in the current Backtrace buffer.")
-(defvar-local backtrace-goto-source-functions nil
+(defvar backtrace-goto-source-functions nil
"Abnormal hook used to jump to the source code for the current frame.
Each hook function is called with no argument, and should return
non-nil if it is able to switch to the buffer containing the
@@ -638,10 +638,8 @@ content of the sexp."
(source-available (plist-get (backtrace-frame-flags frame)
:source-available)))
(unless (and source-available
- (catch 'done
- (dolist (func backtrace-goto-source-functions)
- (when (funcall func)
- (throw 'done t)))))
+ (run-hook-with-args-until-success
+ 'backtrace-goto-source-functions))
(user-error "Source code location not known"))))
(defun backtrace-help-follow-symbol (&optional pos)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0d9ba57..1f5022c 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -26,7 +26,7 @@
;; Packing and unpacking of (binary) data structures.
;;
;; The data formats used in binary files and network protocols are
-;; often structed data which can be described by a C-style structure
+;; often structured data which can be described by a C-style structure
;; such as the one shown below. Using the bindat package, decoding
;; and encoding binary data formats like these is made simple using a
;; structure specification which closely resembles the C style
@@ -65,13 +65,15 @@
;; The corresponding Lisp bindat specification looks like this:
;;
;; (setq header-bindat-spec
-;; '((dest-ip ip)
+;; (bindat-spec
+;; (dest-ip ip)
;; (src-ip ip)
;; (dest-port u16)
;; (src-port u16)))
;;
;; (setq data-bindat-spec
-;; '((type u8)
+;; (bindat-spec
+;; (type u8)
;; (opcode u8)
;; (length u16r) ;; little endian order
;; (id strz 8)
@@ -79,7 +81,8 @@
;; (align 4)))
;;
;; (setq packet-bindat-spec
-;; '((header struct header-bindat-spec)
+;; (bindat-spec
+;; (header struct header-bindat-spec)
;; (items u8)
;; (fill 3)
;; (item repeat (items)
@@ -126,28 +129,30 @@
;; SPEC ::= ( ITEM... )
-;; ITEM ::= ( [FIELD] TYPE )
+;; ITEM ::= ( FIELD TYPE )
;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only
;; | ( [FIELD] fill LEN ) -- skip LEN bytes
;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
;; | ( [FIELD] struct SPEC_NAME )
;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] )
-;; | ( [FIELD] repeat COUNT ITEM... )
+;; | ( FIELD repeat ARG ITEM... )
;; -- In (eval EXPR), the value of the last field is available in
-;; the dynamically bound variable `last'.
+;; the dynamically bound variable `last' and all the previous
+;; ones in the variable `struct'.
;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE
;; | u8 | byte -- length 1
;; | u16 | word | short -- length 2, network byte order
;; | u24 -- 3-byte value
;; | u32 | dword | long -- length 4, network byte order
-;; | u16r | u24r | u32r -- little endian byte order.
+;; | u64 -- length 8, network byte order
+;; | u16r | u24r | u32r | u64r - little endian byte order.
;; | str LEN -- LEN byte string
;; | strz LEN -- LEN byte (zero-terminated) string
;; | vec LEN [TYPE] -- vector of LEN items of TYPE
(default: u8)
;; | ip -- 4 byte vector
-;; | bits LEN -- List with bits set in LEN bytes.
+;; | bits LEN -- bit vector using LEN bytes.
;;
;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
;; and 0x1c 0x28 to (3 5 10 11 12).
@@ -178,7 +183,7 @@
;; is interpreted by evalling TAG_VAL and then comparing that to
;; each TAG using equal; if a match is found, the corresponding SPEC
;; is used.
-;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
+;; If TAG is a form (eval EXPR), EXPR is eval'ed with `tag' bound to the
;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
;;
@@ -191,7 +196,7 @@
;;; Code:
;; Helper functions for structure unpacking.
-;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
+;; Relies on dynamic binding of `bindat-raw' and `bindat-idx'.
(defvar bindat-raw)
(defvar bindat-idx)
@@ -210,6 +215,9 @@
(defun bindat--unpack-u32 ()
(logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16)))
+(defun bindat--unpack-u64 ()
+ (logior (ash (bindat--unpack-u32) 32) (bindat--unpack-u32)))
+
(defun bindat--unpack-u16r ()
(logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8)))
@@ -219,25 +227,26 @@
(defun bindat--unpack-u32r ()
(logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16)))
+(defun bindat--unpack-u64r ()
+ (logior (bindat--unpack-u32r) (ash (bindat--unpack-u32r) 32)))
+
(defun bindat--unpack-item (type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
- (cond
- ((memq type '(u8 byte))
+ (pcase type
+ ((or 'u8 'byte)
(bindat--unpack-u8))
- ((memq type '(u16 word short))
+ ((or 'u16 'word 'short)
(bindat--unpack-u16))
- ((eq type 'u24)
- (bindat--unpack-u24))
- ((memq type '(u32 dword long))
+ ('u24 (bindat--unpack-u24))
+ ((or 'u32 'dword 'long)
(bindat--unpack-u32))
- ((eq type 'u16r)
- (bindat--unpack-u16r))
- ((eq type 'u24r)
- (bindat--unpack-u24r))
- ((eq type 'u32r)
- (bindat--unpack-u32r))
- ((eq type 'bits)
+ ('u64 (bindat--unpack-u64))
+ ('u16r (bindat--unpack-u16r))
+ ('u24r (bindat--unpack-u24r))
+ ('u32r (bindat--unpack-u32r))
+ ('u64r (bindat--unpack-u64r))
+ ('bits
(let ((bits nil) (bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
(if (= (setq m (bindat--unpack-u8)) 0)
@@ -249,12 +258,12 @@
(setq bnum (1- bnum)
j (ash j -1)))))
bits))
- ((eq type 'str)
+ ('str
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(apply #'unibyte-string s))))
- ((eq type 'strz)
+ ('strz
(let ((i 0) s)
(while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
@@ -262,34 +271,29 @@
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(apply #'unibyte-string s))))
- ((eq type 'vec)
- (let ((v (make-vector len 0)) (i 0) (vlen 1))
+ ('vec
+ (let ((v (make-vector len 0)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
- (while (< i len)
- (aset v i (bindat--unpack-item type vlen vectype))
- (setq i (1+ i)))
+ (dotimes (i len)
+ (aset v i (bindat--unpack-item type vlen vectype)))
v))
- (t nil)))
+ (_ nil)))
(defun bindat--unpack-group (spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
(let (struct last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3)
data)
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -299,29 +303,29 @@
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq data (eval len t))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
+ ('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('struct
(setq data (bindat--unpack-group (eval len t))))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (push (bindat--unpack-group (nthcdr tail item)) data)
- (setq index (1+ index)))
- (setq data (nreverse data))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (_ len)
+ (push (bindat--unpack-group (nthcdr tail item)) data))
+ (setq data (nreverse data)))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -333,7 +337,8 @@
(and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
- (t
+ ((pred integerp) (debug t))
+ (_
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
@@ -367,30 +372,26 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq field (cdr field)))
struct)
-
-;; Calculate bindat-raw length of structured data
+;;;; Calculate bindat-raw length of structured data
(defvar bindat--fixed-length-alist
'((u8 . 1) (byte . 1)
(u16 . 2) (u16r . 2) (word . 2) (short . 2)
(u24 . 3) (u24r . 3)
(u32 . 4) (u32r . 4) (dword . 4) (long . 4)
+ (u64 . 8) (u64r . 8)
(ip . 4)))
(defun bindat--length-group (struct spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
- (let (last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -400,6 +401,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
@@ -410,27 +413,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil)))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
+ ('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('struct
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len t)))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (bindat--length-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))
- (setq index (1+ index)))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (index len)
+ (bindat--length-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -443,7 +444,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
- (t
+ (_
(if (setq type (assq type bindat--fixed-length-alist))
(setq len (* len (cdr type))))
(if field
@@ -451,13 +452,13 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (+ bindat-idx len))))))))
(defun bindat-length (spec struct)
- "Calculate bindat-raw length for STRUCT according to bindat SPEC."
+ "Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
(let ((bindat-idx 0))
(bindat--length-group struct spec)
bindat-idx))
-;; Pack structured data into bindat-raw
+;;;; Pack structured data into bindat-raw
(defun bindat--pack-u8 (v)
(aset bindat-raw bindat-idx (logand v 255))
@@ -476,6 +477,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16 (ash v -16))
(bindat--pack-u16 v))
+(defun bindat--pack-u64 (v)
+ (bindat--pack-u32 (ash v -32))
+ (bindat--pack-u32 v))
+
(defun bindat--pack-u16r (v)
(aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255))
(aset bindat-raw bindat-idx (logand v 255))
@@ -489,27 +494,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16r v)
(bindat--pack-u16r (ash v -16)))
+(defun bindat--pack-u64r (v)
+ (bindat--pack-u32r v)
+ (bindat--pack-u32r (ash v -32)))
+
(defun bindat--pack-item (v type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
- (cond
- ((null v)
+ (pcase type
+ ((guard (null v))
(setq bindat-idx (+ bindat-idx len)))
- ((memq type '(u8 byte))
+ ((or 'u8 'byte)
(bindat--pack-u8 v))
- ((memq type '(u16 word short))
+ ((or 'u16 'word 'short)
(bindat--pack-u16 v))
- ((eq type 'u24)
+ ('u24
(bindat--pack-u24 v))
- ((memq type '(u32 dword long))
+ ((or 'u32 'dword 'long)
(bindat--pack-u32 v))
- ((eq type 'u16r)
- (bindat--pack-u16r v))
- ((eq type 'u24r)
- (bindat--pack-u24r v))
- ((eq type 'u32r)
- (bindat--pack-u32r v))
- ((eq type 'bits)
+ ('u64 (bindat--pack-u64 v))
+ ('u16r (bindat--pack-u16r v))
+ ('u24r (bindat--pack-u24r v))
+ ('u32r (bindat--pack-u32r v))
+ ('u64r (bindat--pack-u64r v))
+ ('bits
(let ((bnum (1- (* 8 len))) j m)
(while (>= bnum 0)
(setq m 0)
@@ -522,41 +530,33 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bnum (1- bnum)
j (ash j -1))))
(bindat--pack-u8 m))))
- ((memq type '(str strz))
- (let ((l (length v)) (i 0))
- (if (> l len) (setq l len))
- (while (< i l)
- (aset bindat-raw (+ bindat-idx i) (aref v i))
- (setq i (1+ i)))
- (setq bindat-idx (+ bindat-idx len))))
- ((eq type 'vec)
- (let ((l (length v)) (i 0) (vlen 1))
+ ((or 'str 'strz)
+ (dotimes (i (min len (length v)))
+ (aset bindat-raw (+ bindat-idx i) (aref v i)))
+ (setq bindat-idx (+ bindat-idx len)))
+ ('vec
+ (let ((l (length v)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
(if (> l len) (setq l len))
- (while (< i l)
- (bindat--pack-item (aref v i) type vlen vectype)
- (setq i (1+ i)))))
- (t
+ (dotimes (i l)
+ (bindat--pack-item (aref v i) type vlen vectype))))
+ (_
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
- (let (last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -566,31 +566,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
+ ('align
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('struct
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len t)))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (bindat--pack-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))
- (setq index (1+ index)))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (index len)
+ (bindat--pack-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -603,7 +603,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
- (t
+ (_
(setq last (bindat-get-field struct field))
(bindat--pack-item last type len vectype)
))))))
@@ -622,21 +622,61 @@ Optional fourth arg IDX is the starting offset into RAW."
(bindat--pack-group struct spec)
(if raw nil bindat-raw)))
+;;;; Debugging support
+
+(def-edebug-elem-spec 'bindat-spec '(&rest bindat-item))
+
+
+(def-edebug-elem-spec 'bindat--item-aux
+ ;; Field types which can come without a field label.
+ '(&or ["eval" form]
+ ["fill" bindat-len]
+ ["align" bindat-len]
+ ["struct" form] ;A reference to another bindat-spec.
+ ["union" bindat-tag-val &rest (bindat-tag bindat-spec)]))
+
+(def-edebug-elem-spec 'bindat-item
+ '((&or bindat--item-aux ;Without label..
+ [bindat-field ;..or with label
+ &or bindat--item-aux
+ ["repeat" bindat-arg bindat-spec]
+ bindat-type])))
+
+(def-edebug-elem-spec 'bindat-type
+ '(&or ("eval" form)
+ ["str" bindat-len]
+ ["strz" bindat-len]
+ ["vec" bindat-len &optional bindat-type]
+ ["bits" bindat-len]
+ symbolp))
+
+(def-edebug-elem-spec 'bindat-field
+ '(&or ("eval" form) symbolp))
+
+(def-edebug-elem-spec 'bindat-len '(&or [] "nil" bindat-arg))
+
+(def-edebug-elem-spec 'bindat-tag-val '(bindat-arg))
+
+(def-edebug-elem-spec 'bindat-tag '(&or ("eval" form) atom))
+
+(def-edebug-elem-spec 'bindat-arg
+ '(&or ("eval" form) integerp (&rest symbolp integerp)))
+
+(defmacro bindat-spec (&rest fields)
+ "Build the bindat spec described by FIELDS."
+ (declare (indent 0) (debug (bindat-spec)))
+ ;; FIXME: We should really "compile" this to a triplet of functions!
+ `',fields)
-;; Misc. format conversions
+;;;; Misc. format conversions
(defun bindat-format-vector (vect fmt sep &optional len)
"Format vector VECT using element format FMT and separator SEP.
Result is a string with each element of VECT formatted using FMT and
separated by the string SEP. If optional fourth arg LEN is given, use
only that many elements from VECT."
- (unless len
- (setq len (length vect)))
- (let ((i len) (fmt2 (concat sep fmt)) (s nil))
- (while (> i 0)
- (setq i (1- i)
- s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
- (apply #'concat s)))
+ (when len (setq vect (substring vect 0 len)))
+ (mapconcat (lambda (x) (format fmt x)) vect sep))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 8851f0e..e0feb95 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -458,16 +458,22 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(cons fn (byte-optimize-body exps for-effect)))
(`(if ,test ,then . ,else)
+ ;; FIXME: We are conservative here: any variable changed in the
+ ;; THEN branch will be barred from substitution in the ELSE
+ ;; branch, despite the branches being mutually exclusive.
+
;; The test is always executed.
(let* ((test-opt (byte-optimize-form test nil))
- ;; The THEN and ELSE branches are executed conditionally.
- ;;
- ;; FIXME: We are conservative here: any variable changed in the
- ;; THEN branch will be barred from substitution in the ELSE
- ;; branch, despite the branches being mutually exclusive.
- (byte-optimize--vars-outside-condition byte-optimize--lexvars)
- (then-opt (byte-optimize-form then for-effect))
- (else-opt (byte-optimize-body else for-effect)))
+ (const (macroexp-const-p test-opt))
+ ;; The branches are traversed unconditionally when possible.
+ (byte-optimize--vars-outside-condition
+ (if const
+ byte-optimize--vars-outside-condition
+ byte-optimize--lexvars))
+ ;; Avoid traversing dead branches.
+ (then-opt (and test-opt (byte-optimize-form then for-effect)))
+ (else-opt (and (not (and test-opt const))
+ (byte-optimize-body else for-effect))))
`(if ,test-opt ,then-opt . ,else-opt)))
(`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
@@ -587,16 +593,15 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
- ;; If it's bound outside conditional, invalidate.
- (if (assq var byte-optimize--vars-outside-condition)
- ;; We are in conditional code and the variable was
- ;; bound outside: cancel substitutions.
- (setcdr (cdr lexvar) nil)
- ;; Set a new value (if substitutable).
- (setcdr (cdr lexvar)
- (and (byte-optimize--substitutable-p value)
- (list value))))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ ;; Set a new value or inhibit further substitution.
+ (setcdr (cdr lexvar)
+ (and
+ ;; Inhibit if bound outside conditional code.
+ (not (assq var byte-optimize--vars-outside-condition))
+ ;; The new value must be substitutable.
+ (byte-optimize--substitutable-p value)
+ (list value)))
+ (setcar (cdr lexvar) t)) ; Mark variable to be kept.
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
@@ -638,30 +643,24 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
- ;;
- ;; First, optimize all sub-forms of this one.
- (setq form (byte-optimize-form-code-walker form for-effect))
- ;;
- ;; after optimizing all subforms, optimize this form until it doesn't
- ;; optimize any further. This means that some forms will be passed through
- ;; the optimizer many times, but that's necessary to make the for-effect
- ;; processing do as much as possible.
- ;;
- (let (opt new)
- (if (and (consp form)
- (symbolp (car form))
- (or ;; (and for-effect
- ;; ;; We don't have any of these yet, but we might.
- ;; (setq opt (get (car form)
- ;; 'byte-for-effect-optimizer)))
- (setq opt (function-get (car form) 'byte-optimizer)))
- (not (eq form (setq new (funcall opt form)))))
- (progn
-;; (if (equal form new) (error "bogus optimizer -- %s" opt))
- (byte-compile-log " %s\t==>\t%s" form new)
- (setq new (byte-optimize-form new for-effect))
- new)
- form)))
+ (while
+ (progn
+ ;; First, optimize all sub-forms of this one.
+ (setq form (byte-optimize-form-code-walker form for-effect))
+
+ ;; If a form-specific optimiser is available, run it and start over
+ ;; until a fixpoint has been reached.
+ (and (consp form)
+ (symbolp (car form))
+ (let ((opt (function-get (car form) 'byte-optimizer)))
+ (and opt
+ (let ((old form)
+ (new (funcall opt form)))
+ (byte-compile-log " %s\t==>\t%s" old new)
+ (setq form new)
+ (not (eq new old))))))))
+ ;; Normalise (quote nil) to nil, for a single representation of constant nil.
+ (and (not (equal form '(quote nil))) form))
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
@@ -1563,10 +1562,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; so we create a copy of it, and replace the addresses with
;; TAGs.
(let ((orig-table last-constant))
- (cl-loop for e across constvec
- when (eq e last-constant)
- do (setq last-constant (copy-hash-table e))
- and return nil)
+ (setq last-constant (copy-hash-table last-constant))
;; Replace all addresses with TAGs.
(maphash #'(lambda (value offset)
(let ((match (assq offset tags)))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index a3ad430..5de7bc6 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -113,6 +113,9 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''side-effect-free (list 'quote val))))
+(put 'compiler-macro 'edebug-declaration-spec
+ '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body)))
+
(defalias 'byte-run--set-compiler-macro
#'(lambda (f args compiler-function)
(if (not (eq (car-safe compiler-function) 'lambda))
@@ -148,6 +151,18 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''speed (list 'quote val))))
+(defalias 'byte-run--set-completion
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''completion-predicate val)))
+
+(defalias 'byte-run--set-modes
+ #'(lambda (f _args &rest val)
+ (list 'function-put (list 'quote f)
+ ''completion-predicate
+ `(lambda (_ b)
+ (command-completion-with-modes-p ',val b)))))
+
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@@ -165,7 +180,9 @@ If `error-free', drop calls even if
`byte-compile-delete-errors' is nil.")
(list 'compiler-macro #'byte-run--set-compiler-macro)
(list 'doc-string #'byte-run--set-doc-string)
(list 'indent #'byte-run--set-indent)
- (list 'speed #'byte-run--set-speed))
+ (list 'speed #'byte-run--set-speed)
+ (list 'completion #'byte-run--set-completion)
+ (list 'modes #'byte-run--set-modes))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 709a310..0da7b83 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3020,7 +3020,8 @@ for symbols generated by the byte compiler itself."
;; unless it is the last element of the body.
(if (cdr body)
(setq body (cdr body))))))
- (int (assq 'interactive body)))
+ (int (assq 'interactive body))
+ command-modes)
(when lexical-binding
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
@@ -3031,10 +3032,13 @@ for symbols generated by the byte compiler itself."
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
- (cond ((consp (cdr int))
- (if (cdr (cdr int))
- (byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))
+ (cond ((consp (cdr int)) ; There is an `interactive' spec.
+ ;; Check that the bit after the `interactive' spec is
+ ;; just a list of symbols (i.e., modes).
+ (unless (seq-every-p #'symbolp (cdr (cdr int)))
+ (byte-compile-warn "malformed interactive specc: %s"
+ (prin1-to-string int)))
+ (setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
@@ -3045,15 +3049,14 @@ for symbols generated by the byte compiler itself."
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
- (if (and (eq (car-safe form) 'list)
- ;; For code using lexical-binding, form is not
- ;; valid lisp, but rather an intermediate form
- ;; which may include "calls" to
- ;; internal-make-closure (Bug#29988).
- (not lexical-binding))
- nil
- (setq int `(interactive ,newform)))))
- ((cdr int)
+ (when (or (not (eq (car-safe form) 'list))
+ ;; For code using lexical-binding, form is not
+ ;; valid lisp, but rather an intermediate form
+ ;; which may include "calls" to
+ ;; internal-make-closure (Bug#29988).
+ lexical-binding)
+ (setq int `(interactive ,newform)))))
+ ((cdr int) ; Invalid (interactive . something).
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))))
;; Process the body.
@@ -3070,29 +3073,36 @@ for symbols generated by the byte compiler itself."
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(let ((out
- (apply #'make-byte-code
- (if lexical-binding
- (byte-compile-make-args-desc arglist)
- arglist)
- (append
- ;; byte-string, constants-vector, stack depth
- (cdr compiled)
- ;; optionally, the doc string.
- (cond ((and lexical-binding arglist)
- ;; byte-compile-make-args-desc lost the args's
names,
- ;; so preserve them in the docstring.
- (list (help-add-fundoc-usage doc arglist)))
- ((or doc int)
- (list doc)))
- ;; optionally, the interactive spec.
- (if int
- (list (nth 1 int)))))))
- (when byte-native-compiling
+ (apply #'make-byte-code
+ (if lexical-binding
+ (byte-compile-make-args-desc arglist)
+ arglist)
+ (append
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (cond ((and lexical-binding arglist)
+ ;; byte-compile-make-args-desc lost the args's
names,
+ ;; so preserve them in the docstring.
+ (list (help-add-fundoc-usage doc arglist)))
+ ((or doc int)
+ (list doc)))
+ ;; optionally, the interactive spec (and the modes the
+ ;; command applies to).
+ (cond
+ ;; We have some command modes, so use the vector form.
+ (command-modes
+ (list (vector (nth 1 int) command-modes)))
+ ;; No command modes, use the simple form with just the
+ ;; interactive spec.
+ (int
+ (list (nth 1 int))))))))
+ (when byte-native-compiling
(setf (byte-to-native-lambda-byte-func
(gethash (cadr compiled)
byte-to-native-lambdas-h))
out))
- out))))
+ out))))
(defvar byte-compile-reserved-constants 0)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8e36dbe..279b9d1 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -189,6 +189,32 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value
TAG
(setf (cl--generic name) (setq generic (cl--generic-make name))))
generic))
+(defvar cl--generic-edebug-name nil)
+
+(defun cl--generic-edebug-remember-name (name pf &rest specs)
+ ;; Remember the name in `cl-defgeneric' so we can use it when building
+ ;; the names of its `:methods'.
+ (let ((cl--generic-edebug-name (car name)))
+ (funcall pf specs)))
+
+(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args)
+ ;; The name to use in Edebug for a method: use the generic
+ ;; function's name plus all its qualifiers and finish with
+ ;; its specializers.
+ (pcase-let*
+ ((basename (if in:method cl--generic-edebug-name (pop quals-and-args)))
+ (args (car (last quals-and-args)))
+ (`(,spec-args . ,_) (cl--generic-split-args args))
+ (specializers (mapcar (lambda (spec-arg)
+ (if (eq '&context (car-safe (car spec-arg)))
+ spec-arg (cdr spec-arg)))
+ spec-args)))
+ (format "%s %s"
+ (mapconcat (lambda (sexp) (format "%s" sexp))
+ (cons basename (butlast quals-and-args))
+ " ")
+ specializers)))
+
;;;###autoload
(defmacro cl-defgeneric (name args &rest options-and-methods)
"Create a generic function NAME.
@@ -206,24 +232,22 @@ DEFAULT-BODY, if present, is used as the body of a
default method.
\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
(declare (indent 2) (doc-string 3)
(debug
- (&define [&or name ("setf" name :name setf)] listp
- lambda-doc
- [&rest [&or
- ("declare" &rest sexp)
- (":argument-precedence-order" &rest sexp)
- (&define ":method"
- ;; FIXME: The `:unique'
- ;; construct works around
- ;; Bug#42672. We'd rather want
- ;; names like those generated by
- ;; `cl-defmethod', but that
- ;; requires larger changes to
- ;; Edebug.
- :unique "cl-generic-:method@"
- [&rest cl-generic-method-qualifier]
- cl-generic-method-args lambda-doc
- def-body)]]
- def-body)))
+ (&define
+ &interpose
+ [&name sexp] ;Allow (setf ...) additionally to symbols.
+ cl--generic-edebug-remember-name
+ listp lambda-doc
+ [&rest [&or
+ ("declare" &rest sexp)
+ (":argument-precedence-order" &rest sexp)
+ (&define ":method"
+ [&name
+ [[&rest cl-generic--method-qualifier-p]
+ listp] ;Formal args
+ cl--generic-edebug-make-name in:method]
+ lambda-doc
+ def-body)]]
+ def-body)))
(let* ((doc (if (stringp (car-safe options-and-methods))
(pop options-and-methods)))
(declarations nil)
@@ -398,6 +422,9 @@ the specializer used will be the one returned by BODY."
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+(defun cl-generic--method-qualifier-p (x)
+ (not (listp x)))
+
;;;###autoload
(defmacro cl-defmethod (name args &rest body)
"Define a new method for generic function NAME.
@@ -440,15 +467,14 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
(declare (doc-string 3) (indent defun)
(debug
(&define ; this means we are defining something
- [&or name ("setf" name :name setf)]
- ;; ^^ This is the methods symbol
- [ &rest cl-generic-method-qualifier ]
- ;; Multiple qualifiers are allowed.
- cl-generic-method-args ; arguments
+ [&name [sexp ;Allow (setf ...) additionally to symbols.
+ [&rest cl-generic--method-qualifier-p] ;qualifiers
+ listp] ; arguments
+ cl--generic-edebug-make-name nil]
lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil))
- (while (not (listp args))
+ (while (cl-generic--method-qualifier-p args)
(push args qualifiers)
(setq args (pop body)))
(when (eq 'setf (car-safe name))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3bf3fd2..f06452e 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -140,7 +140,7 @@ to an element already in the list stored in PLACE.
\n(fn X PLACE [KEYWORD VALUE]...)"
(declare (debug
(form place &rest
- &or [[&or ":test" ":test-not" ":key"] function-form]
+ &or [[&or ":test" ":test-not" ":key"] form]
[keywordp form])))
(if (symbolp place)
(if (null keys)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index fb43a0b..709085a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -186,14 +186,14 @@ The name is made by appending a number to PREFIX, default
\"T\"."
;;; Program structure.
-(def-edebug-spec cl-declarations
- (&rest ("cl-declare" &rest sexp)))
+(def-edebug-elem-spec 'cl-declarations
+ '(&rest ("cl-declare" &rest sexp)))
-(def-edebug-spec cl-declarations-or-string
- (&or lambda-doc cl-declarations))
+(def-edebug-elem-spec 'cl-declarations-or-string
+ '(lambda-doc &or ("declare" def-declarations) cl-declarations))
-(def-edebug-spec cl-lambda-list
- (([&rest cl-lambda-arg]
+(def-edebug-elem-spec 'cl-lambda-list
+ '(([&rest cl-lambda-arg]
[&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
[&optional ["&rest" cl-lambda-arg]]
[&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
@@ -202,27 +202,27 @@ The name is made by appending a number to PREFIX, default
\"T\"."
&or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
-(def-edebug-spec cl-&optional-arg
- (&or (cl-lambda-arg &optional def-form arg) arg))
+(def-edebug-elem-spec 'cl-&optional-arg
+ '(&or (cl-lambda-arg &optional def-form arg) arg))
-(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg))
+(def-edebug-elem-spec 'cl-&key-arg
+ '(&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg))
-(def-edebug-spec cl-lambda-arg
- (&or arg cl-lambda-list1))
+(def-edebug-elem-spec 'cl-lambda-arg
+ '(&or arg cl-lambda-list1))
-(def-edebug-spec cl-lambda-list1
- (([&optional ["&whole" arg]] ;; only allowed at lower levels
- [&rest cl-lambda-arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" cl-lambda-arg]]
- [&optional ["&key" cl-&key-arg &rest cl-&key-arg
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-lambda-arg &optional def-form) arg]]
- . [&or arg nil])))
+(def-edebug-elem-spec 'cl-lambda-list1
+ '(([&optional ["&whole" arg]] ;; only allowed at lower levels
+ [&rest cl-lambda-arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" cl-lambda-arg]]
+ [&optional ["&key" cl-&key-arg &rest cl-&key-arg
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-lambda-arg &optional def-form) arg]]
+ . [&or arg nil])))
-(def-edebug-spec cl-type-spec sexp)
+(def-edebug-elem-spec 'cl-type-spec '(sexp))
(defconst cl--lambda-list-keywords
'(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
@@ -358,7 +358,7 @@ more details.
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(declare (debug
;; Same as defun but use cl-lambda-list.
- (&define [&or name ("setf" :name setf name)]
+ (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -376,7 +376,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(declare (debug
;; Same as iter-defun but use cl-lambda-list.
- (&define [&or name ("setf" :name setf name)]
+ (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -390,39 +390,39 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
;; Note that &environment is only allowed as first or last items in the
;; top level list.
-(def-edebug-spec cl-macro-list
- (([&optional "&environment" arg]
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-macro-arg &optional def-form) arg]]
- [&optional "&environment" arg]
- )))
-
-(def-edebug-spec cl-macro-arg
- (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
- (([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-macro-arg &optional def-form) arg]]
- . [&or arg nil])))
+(def-edebug-elem-spec 'cl-macro-list
+ '(([&optional "&environment" arg]
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-macro-arg &optional def-form) arg]]
+ [&optional "&environment" arg]
+ )))
+
+(def-edebug-elem-spec 'cl-macro-arg
+ '(&or arg cl-macro-list1))
+
+(def-edebug-elem-spec 'cl-macro-list1
+ '(([&optional "&whole" arg] ;; only allowed at lower levels
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-macro-arg &optional def-form) arg]]
+ . [&or arg nil])))
;;;###autoload
(defmacro cl-defmacro (name args &rest body)
@@ -452,19 +452,19 @@ more details.
(indent 2))
`(defmacro ,name ,@(cl--transform-lambda (cons args body) name)))
-(def-edebug-spec cl-lambda-expr
- (&define ("lambda" cl-lambda-list
- cl-declarations-or-string
- [&optional ("interactive" interactive)]
- def-body)))
+(def-edebug-elem-spec 'cl-lambda-expr
+ '(&define ("lambda" cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body)))
;; Redefine function-form to also match cl-function
-(def-edebug-spec function-form
+(def-edebug-elem-spec 'function-form
;; form at the end could also handle "function",
;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr)
- ("cl-function" cl-function)
- form))
+ '(&or ([&or "quote" "function"] &or symbolp lambda-expr)
+ ("cl-function" cl-function)
+ form))
;;;###autoload
(defmacro cl-function (func)
@@ -1051,20 +1051,20 @@ For more details, see Info node `(cl)Loop Facility'.
;; [&rest loop-clause]
;; ))
-;; (def-edebug-spec loop-with
-;; ("with" loop-var
+;; (def-edebug-elem-spec 'loop-with
+;; '("with" loop-var
;; loop-type-spec
;; [&optional ["=" form]]
;; &rest ["and" loop-var
;; loop-type-spec
;; [&optional ["=" form]]]))
-;; (def-edebug-spec loop-for-as
-;; ([&or "for" "as"] loop-for-as-subclause
+;; (def-edebug-elem-spec 'loop-for-as
+;; '([&or "for" "as"] loop-for-as-subclause
;; &rest ["and" loop-for-as-subclause]))
-;; (def-edebug-spec loop-for-as-subclause
-;; (loop-var
+;; (def-edebug-elem-spec 'loop-for-as-subclause
+;; '(loop-var
;; loop-type-spec
;; &or
;; [[&or "in" "on" "in-ref" "across-ref"]
@@ -1124,19 +1124,19 @@ For more details, see Info node `(cl)Loop Facility'.
;; [&optional ["by" form]]
;; ]))
-;; (def-edebug-spec loop-initial-final
-;; (&or ["initially"
+;; (def-edebug-elem-spec 'loop-initial-final
+;; '(&or ["initially"
;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
;; &rest loop-non-atomic-expr]
;; ["finally" &or
;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
;; ["return" form]]))
-;; (def-edebug-spec loop-and-clause
-;; (loop-clause &rest ["and" loop-clause]))
+;; (def-edebug-elem-spec 'loop-and-clause
+;; '(loop-clause &rest ["and" loop-clause]))
-;; (def-edebug-spec loop-clause
-;; (&or
+;; (def-edebug-elem-spec 'loop-clause
+;; '(&or
;; [[&or "while" "until" "always" "never" "thereis"] form]
;; [[&or "collect" "collecting"
@@ -1163,10 +1163,10 @@ For more details, see Info node `(cl)Loop Facility'.
;; loop-initial-final
;; ))
-;; (def-edebug-spec loop-non-atomic-expr
-;; ([¬ atom] form))
+;; (def-edebug-elem-spec 'loop-non-atomic-expr
+;; '([¬ atom] form))
-;; (def-edebug-spec loop-var
+;; (def-edebug-elem-spec 'loop-var
;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
;; ;; loop-var =>
;; ;; (loop-var . [&or nil loop-var])
@@ -1175,13 +1175,13 @@ For more details, see Info node `(cl)Loop Facility'.
;; ;; (symbolp . (symbolp . [&or nil loop-var]))
;; ;; (symbolp . (symbolp . loop-var))
;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
-;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+;; '(&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-;; (def-edebug-spec loop-type-spec
-;; (&optional ["of-type" loop-d-type-spec]))
+;; (def-edebug-elem-spec 'loop-type-spec
+;; '(&optional ["of-type" loop-d-type-spec]))
-;; (def-edebug-spec loop-d-type-spec
-;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+;; (def-edebug-elem-spec 'loop-d-type-spec
+;; '(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
(defun cl--parse-loop-clause () ; uses loop-*
(let ((word (pop cl--loop-args))
@@ -2016,8 +2016,9 @@ info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug ((&rest [&or (&define name :unique "cl-flet@" function-form)
- (&define name :unique "cl-flet@"
+ (debug ((&rest [&or (symbolp form)
+ (&define [&name symbolp "@cl-flet@"]
+ [&name [] gensym] ;Make it unique!
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -2192,6 +2193,20 @@ details.
(macroexp-progn body)
newenv)))))
+(defvar edebug-lexical-macro-ctx)
+
+(defun cl--edebug-macrolet-interposer (bindings pf &rest specs)
+ ;; (cl-assert (null (cdr bindings)))
+ (setq bindings (car bindings))
+ (let ((edebug-lexical-macro-ctx
+ (nconc (mapcar (lambda (binding)
+ (cons (car binding)
+ (when (eq 'declare (car-safe (nth 2 binding)))
+ (nth 1 (assq 'debug (cdr (nth 2
binding)))))))
+ bindings)
+ edebug-lexical-macro-ctx)))
+ (funcall pf specs)))
+
;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
@@ -2201,7 +2216,13 @@ This is like `cl-flet', but for macros instead of
functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug (cl-macrolet-expr)))
+ (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"]
+ [&name [] gensym] ;Make it
unique!
+ cl-macro-list
+ cl-declarations-or-string
+ def-body))
+ cl--edebug-macrolet-interposer
+ cl-declarations body)))
(if (cdr bindings)
`(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (macroexp-progn body)
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 54528b2..43d6dfd 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -141,6 +141,9 @@ KEYWORD-ARGS:
:after-hook FORM
A single lisp form which is evaluated after the mode
hooks have been run. It should not be quoted.
+ :interactive BOOLEAN
+ Whether the derived mode should be `interactive' or not.
+ The default is t.
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
@@ -194,6 +197,7 @@ See Info node `(elisp)Derived Modes' for more details.
(declare-syntax t)
(hook (derived-mode-hook-name child))
(group nil)
+ (interactive t)
(after-hook nil))
;; Process the keyword args.
@@ -203,6 +207,7 @@ See Info node `(elisp)Derived Modes' for more details.
(:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
(:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
(:after-hook (setq after-hook (pop body)))
+ (:interactive (setq interactive (pop body)))
(_ (pop body))))
(setq docstring (derived-mode-make-docstring
@@ -246,7 +251,7 @@ No problems result if this variable is not bound.
(defun ,child ()
,docstring
- (interactive)
+ ,(and interactive '(interactive))
; Run the parent.
(delay-mode-hooks
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 2916ae4..4a9e580 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -172,6 +172,10 @@ BODY contains code to execute each time the mode is
enabled or disabled.
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
+: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
+ is useful in.
:variable PLACE The location to use instead of the variable MODE to
store
the state of the mode. This can be simply a different
named variable, or a generalized variable.
@@ -226,6 +230,7 @@ For example, you could write
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook")))
+ (interactive t)
keyw keymap-sym tmp)
;; Check keys.
@@ -245,6 +250,7 @@ For example, you could write
(: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))
(if (not (and (setq tmp (cdr-safe variable))
(or (symbolp tmp)
@@ -303,11 +309,18 @@ or call the function `%s'."))))
;; The actual function.
(defun ,modefun (&optional arg ,@extra-args)
,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
- ;; Use `toggle' rather than (if ,mode 0 1) so that using
- ;; repeat-command still does the toggling correctly.
- (interactive (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- 'toggle)))
+ ,(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)
@@ -317,6 +330,14 @@ or call the function `%s'."))))
nil)
(t
t)))
+ ;; Keep minor modes list up to date.
+ ,@(if globalp
+ `((setq global-minor-modes (delq ',modefun
global-minor-modes))
+ (when ,getter
+ (push ',modefun global-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))
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 5303da3..39b3193 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -183,7 +183,10 @@ This is expected to be bound to a mouse event."
:filter)
'identity)
(symbol-function symbol)))
- symbol)))))
+ symbol))))
+ ;; These symbols are commands, but not interesting for users
+ ;; to `M-x TAB'.
+ (put symbol 'completion-predicate 'ignore))
(dolist (map (if (keymapp maps) (list maps) maps))
(define-key map
(vector 'menu-bar (easy-menu-intern (car menu)))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 0733dce..4599694 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -55,6 +55,7 @@
(require 'backtrace)
(require 'macroexp)
(require 'cl-lib)
+(require 'seq)
(eval-when-compile (require 'pcase))
;;; Options
@@ -244,19 +245,30 @@ If the result is non-nil, then break. Errors are
ignored."
;;; Form spec utilities.
-(defun get-edebug-spec (symbol)
+(defun edebug-get-spec (symbol)
+ "Return the Edebug spec of a given Lisp expression's head SYMBOL.
+The argument is usually a symbol, but it doesn't have to be."
;; Get the spec of symbol resolving all indirection.
(let ((spec nil)
(indirect symbol))
(while
- (progn
- (and (symbolp indirect)
- (setq indirect
- (function-get indirect 'edebug-form-spec 'macro))))
+ (and (symbolp indirect)
+ (setq indirect
+ (function-get indirect 'edebug-form-spec 'macro)))
;; (edebug-trace "indirection: %s" edebug-form-spec)
(setq spec indirect))
spec))
+(define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1")
+
+(defun edebug--get-elem-spec (elem)
+ "Return the specs of the Edebug element ELEM, if any.
+ELEM has to be a symbol."
+ (or (get elem 'edebug-elem-spec)
+ ;; For backward compatibility, we also allow the use of
+ ;; a form's name as a shorthand to refer to its spec.
+ (edebug-get-spec elem)))
+
;;;###autoload
(defun edebug-basic-spec (spec)
"Return t if SPEC uses only extant spec symbols.
@@ -961,6 +973,18 @@ circular objects. Let `read' read everything else."
;;; Cursors for traversal of list and vector elements with offsets.
+;; Edebug's instrumentation is based on parsing the sexps, which come with
+;; auxiliary position information. Instead of keeping the position
+;; information together with the sexps, it is kept in a "parallel
+;; tree" of offsets.
+;;
+;; An "edebug cursor" is a pair of a *list of sexps* (called the
+;; "expressions") together with a matching list of offsets.
+;; When we're parsing the content of a list, the
+;; `edebug-cursor-expressions' is simply the list but when parsing
+;; a vector, the `edebug-cursor-expressions' is a list formed of the
+;; elements of the vector.
+
(defvar edebug-dotted-spec nil
"Set to t when matching after the dot in a dotted spec list.")
@@ -1015,8 +1039,8 @@ circular objects. Let `read' read everything else."
;; The following test should always fail.
(if (edebug-empty-cursor cursor)
(edebug-no-match cursor "Not enough arguments."))
- (setcar cursor (cdr (car cursor)))
- (setcdr cursor (cdr (cdr cursor)))
+ (cl-callf cdr (car cursor))
+ (cl-callf cdr (cdr cursor))
cursor)
@@ -1067,8 +1091,6 @@ circular objects. Let `read' read everything else."
;; This data is shared by all embedded definitions.
(defvar edebug-top-window-data)
-(defvar edebug-&optional)
-(defvar edebug-&rest)
(defvar edebug-gate nil) ;; whether no-match forces an error.
(defvar edebug-def-name nil) ; name of definition, used by interactive-form
@@ -1119,8 +1141,6 @@ purpose by adding an entry to this alist, and setting
edebug-top-window-data
edebug-def-name;; make sure it is locally nil
;; I don't like these here!!
- edebug-&optional
- edebug-&rest
edebug-gate
edebug-best-error
edebug-error-point
@@ -1153,7 +1173,7 @@ purpose by adding an entry to this alist, and setting
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol
(setq def-kind (read (current-buffer))
- spec (and (symbolp def-kind) (get-edebug-spec def-kind))
+ spec (and (symbolp def-kind) (edebug-get-spec def-kind))
defining-form-p (and (listp spec)
(eq '&define (car spec)))
;; This is incorrect in general!! But OK most of the time.
@@ -1164,6 +1184,9 @@ purpose by adding an entry to this alist, and setting
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(let ((result
(cond
+ ;; IIUC, `&define' is treated specially here so as to avoid
+ ;; entering Edebug during the actual function's definition:
+ ;; we only want to enter Edebug later when the thing is called.
(defining-form-p
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
@@ -1211,26 +1234,12 @@ purpose by adding an entry to this alist, and setting
(funcall edebug-after-instrumentation-function result))))
(defvar edebug-def-args) ; args of defining form.
-(defvar edebug-def-interactive) ; is it an emacs interactive function?
(defvar edebug-inside-func) ;; whether code is inside function context.
;; Currently def-form sets this to nil; def-body sets it to t.
-(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
-
-(defun edebug-interactive-p-name ()
- ;; Return a unique symbol for the variable used to store the
- ;; status of interactive-p for this function.
- (intern (format "edebug-%s-interactive-p" edebug-def-name)))
-
-
-(defun edebug-wrap-def-body (forms)
- "Wrap the FORMS of a definition body."
- (if edebug-def-interactive
- `(let ((,(edebug-interactive-p-name)
- (called-interactively-p 'interactive)))
- ,(edebug-make-enter-wrapper forms))
- (edebug-make-enter-wrapper forms)))
+(defvar edebug-lexical-macro-ctx nil
+ "Alist mapping lexically scoped macro names to their debug spec.")
(defun edebug-make-enter-wrapper (forms)
;; Generate the enter wrapper for some forms of a definition.
@@ -1380,7 +1389,6 @@ contains a circular object."
(edebug-old-def-name (edebug--form-data-name form-data-entry))
edebug-def-name
edebug-def-args
- edebug-def-interactive
edebug-inside-func;; whether wrapped code executes inside a function.
)
@@ -1500,9 +1508,12 @@ contains a circular object."
((consp form)
;; The first offset for a list form is for the list form itself.
(if (eq 'quote (car form))
+ ;; This makes sure we don't instrument 'foo
+ ;; which would cause the debugger to single-step
+ ;; the trivial evaluation of a constant.
form
(let* ((head (car form))
- (spec (and (symbolp head) (get-edebug-spec head)))
+ (spec (and (symbolp head) (edebug-get-spec head)))
(new-cursor (edebug-new-cursor form offset)))
;; Find out if this is a defining form from first symbol.
;; An indirect spec would not work here, yet.
@@ -1542,13 +1553,10 @@ contains a circular object."
(defsubst edebug-list-form-args (head cursor)
;; Process the arguments of a list form given that head of form is a symbol.
;; Helper for edebug-list-form
- (let ((spec (get-edebug-spec head)))
+ (let* ((lex-spec (assq head edebug-lexical-macro-ctx))
+ (spec (if lex-spec (cdr lex-spec)
+ (edebug-get-spec head))))
(cond
- ;; Treat cl-macrolet bindings like macros with no spec.
- ((member head edebug--cl-macrolet-defs)
- (if edebug-eval-macro-args
- (edebug-forms cursor)
- (edebug-sexps cursor)))
(spec
(cond
((consp spec)
@@ -1562,7 +1570,7 @@ contains a circular object."
; but leave it in for compatibility.
))
;; No edebug-form-spec provided.
- ((macrop head)
+ ((or lex-spec (macrop head))
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
@@ -1575,10 +1583,7 @@ contains a circular object."
;; The after offset will be left in the cursor after processing the form.
(let ((head (edebug-top-element-required cursor "Expected elements"))
;; Prevent backtracking whenever instrumenting.
- (edebug-gate t)
- ;; A list form is never optional because it matches anything.
- (edebug-&optional nil)
- (edebug-&rest nil))
+ (edebug-gate t))
;; Skip the first offset.
(edebug-set-cursor cursor (edebug-cursor-expressions cursor)
(cdr (edebug-cursor-offsets cursor)))
@@ -1586,11 +1591,6 @@ contains a circular object."
((symbolp head)
(cond
((null head) nil) ; () is valid.
- ((eq head 'interactive-p)
- ;; Special case: replace (interactive-p) with variable
- (setq edebug-def-interactive 'check-it)
- (edebug-move-cursor cursor)
- (edebug-interactive-p-name))
(t
(cons head (edebug-list-form-args
head (edebug-move-cursor cursor))))))
@@ -1628,7 +1628,7 @@ contains a circular object."
(setq edebug-error-point (or edebug-error-point
(edebug-before-offset cursor))
edebug-best-error (or edebug-best-error args))
- (if (and edebug-gate (not edebug-&optional))
+ (if edebug-gate
(progn
(if edebug-error-point
(goto-char edebug-error-point))
@@ -1639,13 +1639,11 @@ contains a circular object."
(defun edebug-match (cursor specs)
;; Top level spec matching function.
;; Used also at each lower level of specs.
- (let (edebug-&optional
- edebug-&rest
- edebug-best-error
+ (let (edebug-best-error
edebug-error-point
(edebug-gate edebug-gate) ;; locally bound to limit effect
)
- (edebug-match-specs cursor specs 'edebug-match-specs)))
+ (edebug-match-specs cursor specs #'edebug-match-specs)))
(defun edebug-match-one-spec (cursor spec)
@@ -1687,7 +1685,7 @@ contains a circular object."
(first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
(match (cond
((eq ?& first-char);; "&" symbols take all following specs.
- (edebug--handle-&-spec-op spec cursor (cdr specs)))
+ (edebug--match-&-spec-op spec cursor (cdr specs)))
((eq ?: first-char);; ":" symbols take one following spec.
(setq rest (cdr (cdr specs)))
(edebug--handle-:-spec-op spec cursor (car (cdr specs))))
@@ -1724,28 +1722,20 @@ contains a circular object."
(dolist (pair '((form . edebug-match-form)
(sexp . edebug-match-sexp)
(body . edebug-match-body)
- (name . edebug-match-name)
(arg . edebug-match-arg)
(def-body . edebug-match-def-body)
(def-form . edebug-match-def-form)
;; Less frequently used:
;; (function . edebug-match-function)
- (lambda-expr . edebug-match-lambda-expr)
- (cl-generic-method-qualifier
- . edebug-match-cl-generic-method-qualifier)
- (cl-generic-method-args . edebug-match-cl-generic-method-args)
- (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
- (cl-macrolet-name . edebug-match-cl-macrolet-name)
- (cl-macrolet-body . edebug-match-cl-macrolet-body)
(place . edebug-match-place)
(gate . edebug-match-gate)
;; (nil . edebug-match-nil) not this one - special case it.
))
- (put (car pair) 'edebug-form-spec (cdr pair)))
+ (put (car pair) 'edebug-elem-spec (cdr pair)))
(defun edebug-match-symbol (cursor symbol)
;; Match a symbol spec.
- (let* ((spec (get-edebug-spec symbol)))
+ (let* ((spec (edebug--get-elem-spec symbol)))
(cond
(spec
(if (consp spec)
@@ -1784,13 +1774,12 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
;; Keep matching until one spec fails.
- (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
+ (edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
(defun edebug-&optional-wrapper (cursor specs remainder-handler)
(let (result
- (edebug-&optional specs)
(edebug-gate nil)
(this-form (edebug-cursor-expressions cursor))
(this-offset (edebug-cursor-offsets cursor)))
@@ -1805,24 +1794,24 @@ contains a circular object."
nil)))
-(defun edebug-&rest-wrapper (cursor specs remainder-handler)
- (if (null specs) (setq specs edebug-&rest))
- ;; Reuse the &optional handler with this as the remainder handler.
- (edebug-&optional-wrapper cursor specs remainder-handler))
-
-(cl-defgeneric edebug--handle-&-spec-op (op cursor specs)
+(cl-defgeneric edebug--match-&-spec-op (op cursor specs)
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
;; Repeatedly use specs until failure.
- (let ((edebug-&rest specs) ;; remember these
- edebug-best-error
+ (let (edebug-best-error
edebug-error-point)
- (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
+ ;; Reuse the &optional handler with this as the remainder handler.
+ (edebug-&optional-wrapper
+ cursor specs
+ (lambda (c s rh)
+ ;; `s' is the remaining spec to match.
+ ;; When it's nil, start over matching `specs'.
+ (edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1846,24 +1835,48 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+ "Compute the specs for `&interpose SPEC FUN ARGS...'.
+Extracts the head of the data by matching it against SPEC,
+and then matches the rest by calling (FUN HEAD PF ARGS...)
+where PF is the parsing function which FUN can call exactly once,
+passing it the specs that it needs to match.
+Note that HEAD will always be a list, since specs are defined to match
+a sequence of elements."
+ (pcase-let*
+ ((`(,spec ,fun . ,args) specs)
+ (exps (edebug-cursor-expressions cursor))
+ (instrumented-head (edebug-match-one-spec cursor spec))
+ (consumed (- (length exps)
+ (length (edebug-cursor-expressions cursor))))
+ (head (seq-subseq exps 0 consumed)))
+ (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
+ (apply fun `(,head
+ ,(lambda (newspecs)
+ ;; FIXME: What'd be the difference if we used
+ ;; `edebug-match-sublist', which is what
+ ;; `edebug-list-form-args' uses for the similar purpose
+ ;; when matching "normal" forms?
+ (append instrumented-head (edebug-match cursor newspecs)))
+ ,@args))))
+
+(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
(save-excursion
- (edebug--handle-&-spec-op '&or cursor specs)))
+ (edebug--match-&-spec-op '&or cursor specs)))
nil))
;; This means something matched, so it is a no match.
(edebug-no-match cursor "Unexpected"))
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
- (edebug--handle-&-spec-op
+ (edebug--match-&-spec-op
'&rest
cursor
(cons '&or
@@ -1872,7 +1885,7 @@ contains a circular object."
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1941,19 +1954,15 @@ contains a circular object."
(defun edebug-match-sublist (cursor specs)
;; Match a sublist of specs.
- (let (edebug-&optional
- ;;edebug-best-error
- ;;edebug-error-point
- )
- (prog1
- ;; match with edebug-match-specs so edebug-best-error is not bound.
- (edebug-match-specs cursor specs 'edebug-match-specs)
- (if (not (edebug-empty-cursor cursor))
- (if edebug-best-error
- (apply #'edebug-no-match cursor edebug-best-error)
- ;; A failed &rest or &optional spec may leave some args.
- (edebug-no-match cursor "Failed matching" specs)
- )))))
+ (prog1
+ ;; match with edebug-match-specs so edebug-best-error is not bound.
+ (edebug-match-specs cursor specs 'edebug-match-specs)
+ (if (not (edebug-empty-cursor cursor))
+ (if edebug-best-error
+ (apply #'edebug-no-match cursor edebug-best-error)
+ ;; A failed &rest or &optional spec may leave some args.
+ (edebug-no-match cursor "Failed matching" specs)
+ ))))
(defun edebug-match-string (cursor spec)
@@ -1976,7 +1985,7 @@ contains a circular object."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1990,45 +1999,61 @@ contains a circular object."
offsets)
specs))
-(defun edebug-match-lambda-expr (cursor)
- ;; The expression must be a function.
- ;; This will match any list form that begins with a symbol
- ;; that has an edebug-form-spec beginning with &define. In
- ;; practice, only lambda expressions should be used.
- ;; I could add a &lambda specification to avoid confusion.
- (let* ((sexp (edebug-top-element-required
- cursor "Expected lambda expression"))
- (offset (edebug-top-offset cursor))
- (head (and (consp sexp) (car sexp)))
- (spec (and (symbolp head) (get-edebug-spec head)))
- (edebug-inside-func nil))
- ;; Find out if this is a defining form from first symbol.
- (if (and (consp spec) (eq '&define (car spec)))
- (prog1
- (list
- (edebug-defining-form
- (edebug-new-cursor sexp offset)
- (car offset);; before the sexp
- (edebug-after-offset cursor)
- (cons (symbol-name head) (cdr spec))))
- (edebug-move-cursor cursor))
- (edebug-no-match cursor "Expected lambda expression")
- )))
-
-
-(defun edebug-match-name (cursor)
- ;; Set the edebug-def-name bound in edebug-defining-form.
- (let ((name (edebug-top-element-required cursor "Expected name")))
- ;; Maybe strings and numbers could be used.
- (if (not (symbolp name))
- (edebug-no-match cursor "Symbol expected for name of definition"))
- (setq edebug-def-name
- (if edebug-def-name
- ;; Construct a new name by appending to previous name.
- (intern (format "%s@%s" edebug-def-name name))
- name))
- (edebug-move-cursor cursor)
- (list name)))
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+ "Compute the name for `&name SPEC FUN` spec operator.
+
+The full syntax of that operator is:
+ &name [PRESTRING] SPEC [POSTSTRING] FUN ARGS...
+
+Extracts the head of the data by matching it against SPEC,
+and then get the new name to use by calling
+ (FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING])
+FUN should return either a string or a symbol.
+FUN can be missing in which case it defaults to concatenating
+the new name to the end of the old with an \"@\" char between the two.
+PRESTRING and POSTSTRING are optional strings that get prepended
+or appended to the actual name."
+ (pcase-let*
+ ((`(,spec ,fun . ,args) specs)
+ (prestrings (when (stringp spec)
+ (prog1 (list spec) (setq spec fun fun (pop args)))))
+ (poststrings (when (stringp fun)
+ (prog1 (list fun) (setq fun (pop args)))))
+ (exps (edebug-cursor-expressions cursor))
+ (instrumented (edebug-match-one-spec cursor spec))
+ (consumed (- (length exps)
+ (length (edebug-cursor-expressions cursor))))
+ (newname (apply (or fun #'edebug--concat-name)
+ `(,@args ,edebug-def-name
+ ,@prestrings
+ ,@(seq-subseq exps 0 consumed)
+ ,@poststrings))))
+ (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
+ (setq edebug-def-name (if (stringp newname) (intern newname) newname))
+ instrumented))
+
+(defun edebug--concat-name (oldname &rest newnames)
+ (let ((newname (if (null (cdr newnames))
+ (car newnames)
+ ;; Put spaces between each name, but not for the
+ ;; leading and trailing strings, if any.
+ (let (beg mid end)
+ (dolist (name newnames)
+ (if (stringp name)
+ (push name (if mid end beg))
+ (when end (setq mid (nconc end mid) end nil))
+ (push name mid)))
+ (apply #'concat `(,@(nreverse beg)
+ ,(mapconcat (lambda (x) (format "%s" x))
+ (nreverse mid) " ")
+ ,@(nreverse end)))))))
+ (if (null oldname)
+ (if (or (stringp newname) (symbolp newname))
+ newname
+ (format "%s" newname))
+ (format "%s@%s" edebug-def-name newname))))
+
+(def-edebug-elem-spec 'name '(&name symbolp))
(cl-defgeneric edebug--handle-:-spec-op (op cursor spec)
"Handle :foo spec operators.
@@ -2054,63 +2079,6 @@ SPEC is the symbol name prefix for `gensym'."
suffix)))
nil)
-(defun edebug-match-cl-generic-method-qualifier (cursor)
- "Match a QUALIFIER for `cl-defmethod' at CURSOR."
- (let ((args (edebug-top-element-required cursor "Expected qualifier")))
- ;; Like in CLOS spec, we support any non-list values.
- (unless (atom args) (edebug-no-match cursor "Atom expected"))
- ;; Append the arguments to `edebug-def-name' (Bug#42671).
- (setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
- (edebug-move-cursor cursor)
- (list args)))
-
-(defun edebug-match-cl-generic-method-args (cursor)
- (let ((args (edebug-top-element-required cursor "Expected arguments")))
- (if (not (consp args))
- (edebug-no-match cursor "List expected"))
- ;; Append the arguments to edebug-def-name.
- (setq edebug-def-name
- (intern (format "%s %s" edebug-def-name args)))
- (edebug-move-cursor cursor)
- (list args)))
-
-(defvar edebug--cl-macrolet-defs nil
- "List of symbols found within the bindings of enclosing `cl-macrolet'
forms.")
-(defvar edebug--current-cl-macrolet-defs nil
- "List of symbols found within the bindings of the current `cl-macrolet'
form.")
-
-(defun edebug-match-cl-macrolet-expr (cursor)
- "Match a `cl-macrolet' form at CURSOR."
- (let (edebug--current-cl-macrolet-defs)
- (edebug-match cursor
- '((&rest (&define cl-macrolet-name cl-macro-list
- cl-declarations-or-string
- def-body))
- cl-declarations cl-macrolet-body))))
-
-(defun edebug-match-cl-macrolet-name (cursor)
- "Match the name in a `cl-macrolet' binding at CURSOR.
-Collect the names in `edebug--cl-macrolet-defs' where they
-will be checked by `edebug-list-form-args' and treated as
-macros without a spec."
- (let ((name (edebug-top-element-required cursor "Expected name")))
- (when (not (symbolp name))
- (edebug-no-match cursor "Bad name:" name))
- ;; Change edebug-def-name to avoid conflicts with
- ;; names at global scope.
- (setq edebug-def-name (gensym "edebug-anon"))
- (edebug-move-cursor cursor)
- (push name edebug--current-cl-macrolet-defs)
- (list name)))
-
-(defun edebug-match-cl-macrolet-body (cursor)
- "Match the body of a `cl-macrolet' expression at CURSOR.
-Put the definitions collected in `edebug--current-cl-macrolet-defs'
-into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
- (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
- edebug--cl-macrolet-defs)))
- (edebug-match-body cursor)))
-
(defun edebug-match-arg (cursor)
;; set the def-args bound in edebug-defining-form
(let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
@@ -2139,151 +2107,135 @@ into `edebug--cl-macrolet-defs' which is checked in
`edebug-list-form-args'."
;; This happens to handle bug#20281, tho maybe a better fix would be to
;; improve the `defun' spec.
(when forms
- (list (edebug-wrap-def-body forms)))))
+ (list (edebug-make-enter-wrapper forms)))))
;;;; Edebug Form Specs
;;; ==========================================================
-;;;;* Spec for def-edebug-spec
-;;; Out of date.
-
-(defun edebug-spec-p (object)
- "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
- (and (symbolp object)
- (get object 'edebug-form-spec)))
-
-(def-edebug-spec def-edebug-spec
- ;; Top level is different from lower levels.
- (&define :name edebug-spec name
- &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
-
-(def-edebug-spec edebug-spec-list
- ;; A list must have something in it, or it is nil, a symbolp
- ((edebug-spec . [&or nil edebug-spec])))
-
-(def-edebug-spec edebug-spec
- (&or
- edebug-spec-list
- (vector &rest edebug-spec) ; matches a vector
- ("vector" &rest edebug-spec) ; matches a vector spec
- ("quote" symbolp)
- stringp
- [edebug-lambda-list-keywordp &rest edebug-spec]
- [keywordp gate edebug-spec]
- edebug-spec-p ;; Including all the special ones e.g. form.
- symbolp;; a predicate
- ))
-
-
;;;* Emacs special forms and some functions.
-;; quote expects only one argument, although it allows any number.
-(def-edebug-spec quote sexp)
+(pcase-dolist
+ (`(,name ,spec)
+
+ '((quote (sexp)) ;quote expects only one arg, tho it allows any number.
+
+ ;; The standard defining forms.
+ (defvar (symbolp &optional form stringp))
+ (defconst defvar)
+
+ ;; Contrary to macros, special forms default to assuming that all args
+ ;; are normal forms, so we don't need to do anything about those
+ ;; special forms:
+ ;;(save-current-buffer t)
+ ;;(save-excursion t)
+ ;;...
+ ;;(progn t)
+
+ ;; `defun' and `defmacro' are not special forms (any more), but it's
+ ;; more convenient to define their Edebug spec here.
+ (defun ( &define name lambda-list lambda-doc
+ [&optional ("declare" def-declarations)]
+ [&optional ("interactive" &optional [&or stringp def-form]
+ &rest symbolp)]
+ def-body))
+
+ (defmacro ( &define name lambda-list lambda-doc
+ [&optional ("declare" def-declarations)]
+ def-body))
+
+ ;; function expects a symbol or a lambda or macro expression
+ ;; A macro is allowed by Emacs.
+ (function (&or symbolp lambda-expr))
+
+ ;; FIXME? The manual uses this form (maybe that's just
+ ;; for illustration purposes?):
+ ;; (let ((&rest &or symbolp (gate symbolp &optional form)) body))
+ (let ((&rest &or (symbolp &optional form) symbolp) body))
+ (let* let)
+
+ (setq (&rest symbolp form))
+ (cond (&rest (&rest form)))
+
+ (condition-case ( symbolp form
+ &rest ([&or symbolp (&rest symbolp)] body)))
+
+ (\` (backquote-form))
+
+ ;; Assume immediate quote in unquotes mean backquote at next
+ ;; higher level.
+ (\, (&or ("quote" edebug-\`) def-form))
+ (\,@ (&define ;; so (,@ form) is never wrapped.
+ &or ("quote" edebug-\`) def-form))
+ ))
+ (put name 'edebug-form-spec spec))
+
+(defun edebug--match-declare-arg (head pf)
+ (funcall pf (get (car head) 'edebug-declaration-spec)))
-;; The standard defining forms.
-(def-edebug-spec defconst defvar)
-(def-edebug-spec defvar (symbolp &optional form stringp))
+(def-edebug-elem-spec 'def-declarations
+ '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp))
-(def-edebug-spec defun
- (&define name lambda-list lambda-doc
- [&optional ("declare" &rest sexp)]
- [&optional ("interactive" interactive)]
- def-body))
-(def-edebug-spec defmacro
- ;; FIXME: Improve `declare' so we can Edebug gv-expander and
- ;; gv-setter declarations.
- (&define name lambda-list lambda-doc
- [&optional ("declare" &rest sexp)] def-body))
+(def-edebug-elem-spec 'lambda-list
+ '(([&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )))
-(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
+(def-edebug-elem-spec 'lambda-expr
+ '(("lambda" &define lambda-list lambda-doc
+ [&optional ("interactive" interactive)]
+ def-body)))
-(def-edebug-spec lambda-list
- (([&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )))
+(def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use
lambda-list.
-(def-edebug-spec lambda-doc
- (&optional [&or stringp
- (&define ":documentation" def-form)]))
+(def-edebug-elem-spec 'lambda-doc
+ '(&optional [&or stringp
+ (&define ":documentation" def-form)]))
-(def-edebug-spec interactive
- (&optional &or stringp def-form))
+(def-edebug-elem-spec 'interactive '(&optional [&or stringp def-form]
+ &rest symbolp))
;; A function-form is for an argument that may be a function or a form.
;; This specially recognizes anonymous functions quoted with quote.
-(def-edebug-spec function-form
+(def-edebug-elem-spec 'function-form ;Deprecated, use `form'!
;; form at the end could also handle "function",
;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
-
-;; function expects a symbol or a lambda or macro expression
-;; A macro is allowed by Emacs.
-(def-edebug-spec function (&or symbolp lambda-expr))
-
-;; A macro expression is a lambda expression with "macro" prepended.
-(def-edebug-spec macro (&define "lambda" lambda-list def-body))
-
-;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
-
-;; Standard functions that take function-forms arguments.
-
-;; FIXME? The manual uses this form (maybe that's just for illustration?):
-;; (def-edebug-spec let
-;; ((&rest &or symbolp (gate symbolp &optional form))
-;; body))
-(def-edebug-spec let
- ((&rest &or (symbolp &optional form) symbolp)
- body))
-
-(def-edebug-spec let* let)
-
-(def-edebug-spec setq (&rest symbolp form))
-
-(def-edebug-spec cond (&rest (&rest form)))
-
-(def-edebug-spec condition-case
- (symbolp
- form
- &rest ([&or symbolp (&rest symbolp)] body)))
-
-
-(def-edebug-spec \` (backquote-form))
+ '(&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
;; Supports quotes inside backquotes,
;; but only at the top level inside unquotes.
-(def-edebug-spec backquote-form
- (&or
- ;; Disallow instrumentation of , and ,@ inside a nested backquote, since
- ;; these are likely to be forms generated by a macro being debugged.
- ("`" nested-backquote-form)
- ([&or "," ",@"] &or ("quote" backquote-form) form)
- ;; The simple version:
- ;; (backquote-form &rest backquote-form)
- ;; doesn't handle (a . ,b). The straightforward fix:
- ;; (backquote-form . [&or nil backquote-form])
- ;; uses up too much stack space.
- ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it.
- (backquote-form [&rest [¬ ","] backquote-form]
- . [&or nil backquote-form])
- ;; If you use dotted forms in backquotes, replace the previous line
- ;; with the following. This takes quite a bit more stack space, however.
- ;; (backquote-form . [&or nil backquote-form])
- (vector &rest backquote-form)
- sexp))
-
-(def-edebug-spec nested-backquote-form
- (&or
- ("`" &error "Triply nested backquotes (without commas \"between\" them) \
+(def-edebug-elem-spec 'backquote-form
+ '(&or
+ ;; Disallow instrumentation of , and ,@ inside a nested backquote, since
+ ;; these are likely to be forms generated by a macro being debugged.
+ ("`" nested-backquote-form)
+ ([&or "," ",@"] &or ("quote" backquote-form) form)
+ ;; The simple version:
+ ;; (backquote-form &rest backquote-form)
+ ;; doesn't handle (a . ,b). The straightforward fix:
+ ;; (backquote-form . [&or nil backquote-form])
+ ;; uses up too much stack space.
+ ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it.
+ (backquote-form [&rest [¬ ","] backquote-form]
+ . [&or nil backquote-form])
+ ;; If you use dotted forms in backquotes, replace the previous line
+ ;; with the following. This takes quite a bit more stack space, however.
+ ;; (backquote-form . [&or nil backquote-form])
+ (vector &rest backquote-form)
+ sexp))
+
+(def-edebug-elem-spec 'nested-backquote-form
+ '(&or
+ ("`" &error "Triply nested backquotes (without commas \"between\" them) \
are too difficult to instrument")
- ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
- ;; (\,@ ...) matched on the next line.
- ([&or "," ",@"] backquote-form)
- (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form]
- . [&or nil nested-backquote-form])
- (vector &rest nested-backquote-form)
- sexp))
+ ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
+ ;; (\,@ ...) matched on the next line.
+ ([&or "," ",@"] backquote-form)
+ (nested-backquote-form [&rest [¬ "," ",@"] nested-backquote-form]
+ . [&or nil nested-backquote-form])
+ (vector &rest nested-backquote-form)
+ sexp))
;; Special version of backquote that instruments backquoted forms
;; destined to be evaluated, usually as the result of a
@@ -2298,20 +2250,9 @@ are too difficult to instrument")
;; ,@ might have some problems.
-(defalias 'edebug-\` '\`) ;; same macro as regular backquote.
-(def-edebug-spec edebug-\` (def-form))
-
-;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec \, (&or ("quote" edebug-\`) def-form))
-(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped.
- &or ("quote" edebug-\`) def-form))
-
-;; New byte compiler.
-
-(def-edebug-spec save-selected-window t)
-(def-edebug-spec save-current-buffer t)
-
-;; Anything else?
+(defmacro edebug-\` (exp)
+ (declare (debug (def-form)))
+ (list '\` exp))
;;; The debugger itself
@@ -2485,11 +2426,10 @@ STATUS should be a list returned by
`edebug-var-status'."
(edebug-print-trace-after
(format "%s result: %s" function edebug-result)))))
-(def-edebug-spec edebug-tracing (form body))
-
(defmacro edebug-tracing (msg &rest body)
"Print MSG in *edebug-trace* before and after evaluating BODY.
The result of BODY is also printed."
+ (declare (debug (form body)))
`(let ((edebug-stack-depth (1+ edebug-stack-depth))
edebug-result)
(edebug-print-trace-before ,msg)
@@ -2921,7 +2861,6 @@ See `edebug-behavior-alist' for implementations.")
(defvar edebug-outside-match-data) ; match data outside of edebug
(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
(defvar edebug-inside-windows)
-(defvar edebug-interactive-p)
(defvar edebug-mode-map) ; will be defined fully later.
@@ -2937,7 +2876,6 @@ See `edebug-behavior-alist' for implementations.")
;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
(edebug-recursion-depth (recursion-depth))
edebug-entered ; bind locally to nil
- (edebug-interactive-p nil) ; again non-interactive
edebug-backtrace-buffer ; each recursive edit gets its own
;; The window configuration may be saved and restored
;; during a recursive-edit
@@ -3601,7 +3539,10 @@ canceled the first time the function is entered."
;; Could store this in the edebug data instead.
(put function 'edebug-on-entry (if flag 'temp t)))
-(defalias 'edebug-cancel-edebug-on-entry #'cancel-edebug-on-entry)
+(define-obsolete-function-alias 'edebug-cancel-edebug-on-entry
+ #'edebug-cancel-on-entry "28.1")
+(define-obsolete-function-alias 'cancel-edebug-on-entry
+ #'edebug-cancel-on-entry "28.1")
(defun edebug--edebug-on-entry-functions ()
(let ((functions nil))
@@ -3613,7 +3554,7 @@ canceled the first time the function is entered."
obarray)
functions))
-(defun cancel-edebug-on-entry (function)
+(defun edebug-cancel-on-entry (function)
"Cause Edebug to not stop when FUNCTION is called.
The removes the effect of `edebug-on-entry'. If FUNCTION is is
nil, remove `edebug-on-entry' on all functions."
@@ -3937,10 +3878,14 @@ be installed in `emacs-lisp-mode-map'.")
;; Autoloading these global bindings doesn't make sense because
;; they cannot be used anyway unless Edebug is already loaded and active.
-(defvar global-edebug-prefix "\^XX"
+(define-obsolete-variable-alias 'global-edebug-prefix
+ 'edebug-global-prefix "28.1")
+(defvar edebug-global-prefix "\^XX"
"Prefix key for global edebug commands, available from any buffer.")
-(defvar global-edebug-map
+(define-obsolete-variable-alias 'global-edebug-map
+ 'edebug-global-map "28.1")
+(defvar edebug-global-map
(let ((map (make-sparse-keymap)))
(define-key map " " 'edebug-step-mode)
@@ -3973,9 +3918,9 @@ be installed in `emacs-lisp-mode-map'.")
map)
"Global map of edebug commands, available from any buffer.")
-(when global-edebug-prefix
- (global-unset-key global-edebug-prefix)
- (global-set-key global-edebug-prefix global-edebug-map))
+(when edebug-global-prefix
+ (global-unset-key edebug-global-prefix)
+ (global-set-key edebug-global-prefix edebug-global-map))
(defun edebug-help ()
@@ -4237,7 +4182,8 @@ This should be a list of `edebug---frame' objects.")
(pop-to-buffer edebug-backtrace-buffer)
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode)
- (add-hook 'backtrace-goto-source-functions
#'edebug--backtrace-goto-source))
+ (add-hook 'backtrace-goto-source-functions
+ #'edebug--backtrace-goto-source nil t))
(setq edebug-instrumented-backtrace-frames
(backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame)
@@ -4579,13 +4525,18 @@ With prefix argument, make it a temporary breakpoint."
(add-hook 'called-interactively-p-functions
#'edebug--called-interactively-skip)
(defun edebug--called-interactively-skip (i frame1 frame2)
- (when (and (eq (car-safe (nth 1 frame1)) 'lambda)
- (eq (nth 1 (nth 1 frame1)) '())
- (eq (nth 1 frame2) 'edebug-enter))
+ (when (and (memq (car-safe (nth 1 frame1)) '(lambda closure))
+ ;; Lambda value with no arguments.
+ (null (nth (if (eq (car-safe (nth 1 frame1)) 'lambda) 1 2)
+ (nth 1 frame1)))
+ (memq (nth 1 frame2) '(edebug-enter edebug-default-enter)))
;; `edebug-enter' calls itself on its first invocation.
- (if (eq (nth 1 (backtrace-frame i 'called-interactively-p))
- 'edebug-enter)
- 2 1)))
+ (let ((s 1))
+ (while (memq (nth 1 (backtrace-frame i 'called-interactively-p))
+ '(edebug-enter edebug-default-enter))
+ (cl-incf s)
+ (cl-incf i))
+ s)))
;; Finally, hook edebug into the rest of Emacs.
;; There are probably some other things that could go here.
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index db97d4c..6d84839 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -105,7 +105,7 @@ Summary:
(declare (doc-string 3) (obsolete cl-defmethod "25.1")
(debug
(&define ; this means we are defining something
- [&or name ("setf" name :name setf)]
+ [&name sexp] ;Allow (setf ...) additionally to symbols.
;; ^^ This is the methods symbol
[ &optional symbolp ] ; this is key :before etc
cl-generic-method-args ; arguments
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 90e075b..c95540e 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -248,7 +248,8 @@ expression point is on." :lighter eldoc-minor-mode-string
#'elisp-eldoc-var-docstring nil t)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-funcall nil t)
- (setq eldoc-documentation-strategy 'eldoc-documentation-default)))
+ (setq-local eldoc-documentation-strategy
+ 'eldoc-documentation-default)))
(eldoc-mode +1))
;;;###autoload
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index fdbf953..e08fa7a 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -196,8 +196,8 @@ it has to be wrapped in `(eval (quote ...))'.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
[:tags \\='(TAG...)] BODY...)"
- (declare (debug (&define :name test
- name sexp [&optional stringp]
+ (declare (debug (&define [&name "test@" symbolp]
+ sexp [&optional stringp]
[&rest keywordp sexp] def-body))
(doc-string 3)
(indent 2))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 29f8230..cbbed06 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -187,6 +187,13 @@ arguments as NAME. DO is a function as defined in
`gv-get'."
(push (list 'gv-setter #'gv--setter-defun-declaration)
defun-declarations-alist))
+;;;###autoload
+(let ((spec (get 'compiler-macro 'edebug-declaration-spec)))
+ ;; It so happens that it's the same spec for gv-* as for compiler-macros.
+ ;; '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body))
+ (put 'gv-expander 'edebug-declaration-spec spec)
+ (put 'gv-setter 'edebug-declaration-spec spec))
+
;; (defmacro gv-define-expand (name expander)
;; "Use EXPANDER to handle NAME as a generalized var.
;; NAME is a symbol: the name of a function, macro, or special form.
@@ -224,7 +231,8 @@ The first arg in ARGLIST (the one that receives VAL)
receives an expression
which can do arbitrary things, whereas the other arguments are all guaranteed
to be pure and copyable. Example use:
(gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
- (declare (indent 2) (debug (&define name :name gv-setter sexp def-body)))
+ (declare (indent 2)
+ (debug (&define [&name symbolp "@gv-setter"] sexp def-body)))
`(gv-define-expander ,name
(lambda (do &rest args)
(declare-function
@@ -307,7 +315,7 @@ The return value is the last VAL in the list.
;; Autoload this `put' since a user might use C-u C-M-x on an expression
;; containing a non-trivial `push' even before gv.el was loaded.
;;;###autoload
-(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+(put 'gv-place 'edebug-form-spec '(form)) ;So-called "indirect spec".
;; CL did the equivalent of:
;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 042061c..0934e43 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -299,7 +299,12 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare))
(macroexp--cons fun
(macroexp--cons (macroexp--all-clauses bindings 1)
- (macroexp--all-forms body)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp--warn-and-return
+ (format "Empty %s body" fun)
+ nil t))
+ (macroexp--all-forms body))
(cdr form))
form))
(`(,(and fun `(lambda . ,_)) . ,args)
@@ -572,20 +577,35 @@ test of free variables in the following ways:
- For the same reason it may cause the result to fail to include bindings
which will be used if SEXP is not yet fully macro-expanded and the
use of the binding will only be revealed by macro expansion."
- (let ((res '()))
- (while (and (consp sexp) bindings)
- (dolist (binding (macroexp--fgrep bindings (pop sexp)))
- (push binding res)
- (setq bindings (remove binding bindings))))
- (if (or (vectorp sexp) (byte-code-function-p sexp))
- ;; With backquote, code can appear within vectors as well.
- ;; This wouldn't be needed if we `macroexpand-all' before
- ;; calling macroexp--fgrep, OTOH.
- (macroexp--fgrep bindings (mapcar #'identity sexp))
- (let ((tmp (assq sexp bindings)))
- (if tmp
- (cons tmp res)
- res)))))
+ (let ((res '())
+ ;; Cyclic code should not happen, but code can contain cyclic data :-(
+ (seen (make-hash-table :test #'eq))
+ (sexpss (list (list sexp))))
+ ;; Use a nested while loop to reduce the amount of heap allocations for
+ ;; pushes to `sexpss' and the `gethash' overhead.
+ (while (and sexpss bindings)
+ (let ((sexps (pop sexpss)))
+ (unless (gethash sexps seen)
+ (puthash sexps t seen) ;; Using `setf' here causes bootstrap
problems.
+ (if (vectorp sexps) (setq sexps (mapcar #'identity sexps)))
+ (let ((tortoise sexps) (skip t))
+ (while sexps
+ (let ((sexp (if (consp sexps) (pop sexps)
+ (prog1 sexps (setq sexps nil)))))
+ (if skip
+ (setq skip nil)
+ (setq tortoise (cdr tortoise))
+ (if (eq tortoise sexps)
+ (setq sexps nil) ;; Found a cycle: we're done!
+ (setq skip t)))
+ (cond
+ ((or (consp sexp) (vectorp sexp)) (push sexp sexpss))
+ (t
+ (let ((tmp (assq sexp bindings)))
+ (when tmp
+ (push tmp res)
+ (setq bindings (remove tmp bindings))))))))))))
+ res))
;;; Load-time macro-expansion.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ec746fa..d3928fa 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -27,19 +27,10 @@
;; Todo:
-;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't
-;; use x, because x is bound separately for the equality constraint
-;; (as well as any pred/guard) and for the body, so uses at one place don't
-;; count for the other.
-;; - provide ways to extend the set of primitives, with some kind of
-;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP)
-;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
-;; But better would be if we could define new ways to match by having the
-;; extension provide its own `pcase--split-<foo>' thingy.
-;; - along these lines, provide patterns to match CL structs.
+;; - Allow to provide new `pcase--split-<foo>' thingy.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases
+;; - provide a way to continue matching to subsequent cases
;; (e.g. Like Racket's (=> ID).
;; - try and be more clever to reduce the size of the decision tree, and
;; to reduce the number of leaves that need to be turned into functions:
@@ -71,48 +62,37 @@
(defvar pcase--dontwarn-upats '(pcase--dontcare))
-(def-edebug-spec
- pcase-PAT
- (&or symbolp
- ("or" &rest pcase-PAT)
- ("and" &rest pcase-PAT)
- ("guard" form)
- ("let" pcase-PAT form)
- ("pred" pcase-FUN)
- ("app" pcase-FUN pcase-PAT)
- pcase-MACRO
- sexp))
-
-(def-edebug-spec
- pcase-FUN
- (&or lambda-expr
- ;; Punt on macros/special forms.
- (functionp &rest form)
- sexp))
-
-;; See bug#24717
-(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro)
+(def-edebug-elem-spec 'pcase-PAT
+ '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp))
+
+(def-edebug-elem-spec 'pcase-FUN
+ '(&or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
+ sexp))
;; Only called from edebug.
-(declare-function get-edebug-spec "edebug" (symbol))
-(declare-function edebug-match "edebug" (cursor specs))
+(declare-function edebug-get-spec "edebug" (symbol))
+(defun pcase--edebug-match-pat-args (head pf)
+ ;; (cl-assert (null (cdr head)))
+ (setq head (car head))
+ (or (alist-get head '((quote sexp)
+ (or &rest pcase-PAT)
+ (and &rest pcase-PAT)
+ (guard form)
+ (pred &or ("not" pcase-FUN) pcase-FUN)
+ (app pcase-FUN pcase-PAT)))
+ (let ((me (pcase--get-macroexpander head)))
+ (funcall pf (and me (symbolp me) (edebug-get-spec me))))))
(defun pcase--get-macroexpander (s)
"Return the macroexpander for pcase pattern head S, or nil"
(get s 'pcase-macroexpander))
-(defun pcase--edebug-match-macro (cursor)
- (let (specs)
- (mapatoms
- (lambda (s)
- (let ((m (pcase--get-macroexpander s)))
- (when (and m (get-edebug-spec m))
- (push (cons (symbol-name s) (get-edebug-spec m))
- specs)))))
- (edebug-match cursor (cons '&or specs))))
-
;;;###autoload
(defmacro pcase (exp &rest cases)
+ ;; FIXME: Add some "global pattern" to wrap every case?
+ ;; Could be used to wrap all cases in a `
"Evaluate EXP to get EXPVAL; try passing control to one of CASES.
CASES is a list of elements of the form (PATTERN CODE...).
For the first CASE whose PATTERN \"matches\" EXPVAL,
@@ -946,14 +926,13 @@ Otherwise, it defers to REST which is a list of branches
of the form
(t (error "Unknown pattern `%S'" upat)))))
(t (error "Incorrect MATCH %S" (car matches)))))
-(def-edebug-spec
- pcase-QPAT
+(def-edebug-elem-spec 'pcase-QPAT
;; Cf. edebug spec for `backquote-form' in edebug.el.
- (&or ("," pcase-PAT)
- (pcase-QPAT [&rest [¬ ","] pcase-QPAT]
- . [&or nil pcase-QPAT])
- (vector &rest pcase-QPAT)
- sexp))
+ '(&or ("," pcase-PAT)
+ (pcase-QPAT [&rest [¬ ","] pcase-QPAT]
+ . [&or nil pcase-QPAT])
+ (vector &rest pcase-QPAT)
+ sexp))
(pcase-defmacro \` (qpat)
"Backquote-style pcase patterns: \\=`QPAT
@@ -1002,7 +981,13 @@ The predicate is the logical-AND of:
(pcase-defmacro let (pat expr)
"Matches if EXPR matches PAT."
+ (declare (debug (pcase-PAT form)))
`(app (lambda (_) ,expr) ,pat))
+;; (pcase-defmacro guard (expr)
+;; "Matches if EXPR is non-nil."
+;; (declare (debug (form)))
+;; `(pred (lambda (_) ,expr)))
+
(provide 'pcase)
;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 31c15fe..55ce6d9 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -455,6 +455,7 @@ negative integer or 0, nil is returned."
(setq sequence (seq-drop sequence n)))
(nreverse result))))
+;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4cabd42..73c2b56 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -6,7 +6,7 @@
;; Author: Lawrence Mitchell <wence@gmx.li>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; Created: 2004-05-7
-;; Keywords: IRC chat client internet
+;; Keywords: comm, IRC, chat, client, internet
;; This file is part of GNU Emacs.
@@ -1079,14 +1079,12 @@ Finds hooks by looking in the `erc-server-responses'
hash table."
(erc-display-message parsed 'notice proc line)))
-(put 'define-erc-response-handler 'edebug-form-spec
- '(&define :name erc-response-handler
- (name &rest name)
- &optional sexp sexp def-body))
-
(cl-defmacro define-erc-response-handler ((name &rest aliases)
- &optional extra-fn-doc extra-var-doc
- &rest fn-body)
+ &optional extra-fn-doc extra-var-doc
+ &rest fn-body)
+ (declare (debug (&define [&name "erc-response-handler@"
+ (symbolp &rest symbolp)]
+ &optional sexp sexp def-body)))
"Define an ERC handler hook/function pair.
NAME is the response name as sent by the server (see the IRC RFC for
meanings).
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 71ff408..0a81da3 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc, button, url, regexp
+;; Keywords: comm, irc, button, url, regexp
;; URL: https://www.emacswiki.org/emacs/ErcButton
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 9dedd3c..e72d8fb 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -7,7 +7,7 @@
;; Noah Friedman <friedman@prep.ai.mit.edu>
;; Per Persson <pp@sno.pp.se>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; Created: 1994-01-23
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index 5f1aab1..1f68272 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -4,7 +4,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index e6e5070..1707e71 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -4,7 +4,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc
+;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index b86a8d0..4163e5a 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -6,7 +6,7 @@
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; Old-Version: 1.0.0
;; URL: https://www.emacswiki.org/emacs/ErcLang
-;; Keywords: comm languages processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 4540ec6..22fd3d2 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -5,7 +5,7 @@
;; Author: Lawrence Mitchell <wence@gmx.li>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcLogging
-;; Keywords: IRC, chat, client, Internet, logging
+;; Keywords: comm, IRC, chat, client, Internet, logging
;; Created 2003-04-26
;; Logging code taken from erc.el and modified to use markers.
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 153742a..eede15c 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -4,7 +4,7 @@
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, faces
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcMatch
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 4c092c8..3995a05 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes, menu
+;; Keywords: comm, menu
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index ddaf787..e9ebf0a 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -4,7 +4,7 @@
;; Author: Sacha Chua <sacha@free.net.ph>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, convenience
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcCompletion
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 91fafbb..c67d751 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -6,7 +6,7 @@
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcReplace
-;; Keywords: IRC, client, Internet
+;; Keywords: comm, IRC, client, Internet
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index edde973..fff1639 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -1,4 +1,4 @@
-;;; erc-sound.el --- CTCP SOUND support for ERC
+;;; erc-sound.el --- CTCP SOUND support for ERC -*- lexical-binding: t -*-
;; Copyright (C) 2002-2003, 2006-2021 Free Software Foundation, Inc.
@@ -66,18 +66,15 @@ and play sound files as requested."
(defcustom erc-play-sound t
"Play sounds when you receive CTCP SOUND requests."
- :group 'erc-sound
:type 'boolean)
(defcustom erc-sound-path nil
"List of directories that contain sound samples to play on SOUND events."
- :group 'erc-sound
:type '(repeat directory))
(defcustom erc-default-sound nil
"Play this sound if the requested file was not found.
If this is set to nil or the file doesn't exist a beep will sound."
- :group 'erc-sound
:type '(choice (const nil)
file))
@@ -108,7 +105,7 @@ LINE is the text entered, including the command."
t))
(t nil)))
-(defun erc-ctcp-query-SOUND (proc nick login host to msg)
+(defun erc-ctcp-query-SOUND (_proc nick login host _to msg)
"Display a CTCP SOUND message and play sound if `erc-play-sound' is non-nil."
(when (string-match
"^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg)
(let ((sound (match-string 1 msg))
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 44a3e35..c18ac5b 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -4,7 +4,7 @@
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc
+;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcSpelling
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 2c42a18..da91364 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes, timestamp
+;; Keywords: comm, timestamp
;; URL: https://www.emacswiki.org/emacs/ErcStamp
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index d6ad847..56f6656 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, faces
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 6808f24..db8383b 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index a09c47c..9fccc6b 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -355,7 +355,7 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun pcomplete/eshell-mode/setq ()
"Completion function for Eshell's `setq'."
(while (and (pcomplete-here (all-completions pcomplete-stub
- obarray 'boundp))
+ obarray #'boundp))
(pcomplete-here))))
;; FIXME the real "env" command does more than this, it runs a program
diff --git a/lisp/files.el b/lisp/files.el
index 4c56b5f..b0332d5 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1644,7 +1644,7 @@ called additional times).
This macro actually adds an auxiliary function that calls FUN,
rather than FUN itself, to `minibuffer-setup-hook'."
- (declare (indent 1) (debug t))
+ (declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body)))
(let ((hook (make-symbol "setup-hook"))
(funsym (make-symbol "fun"))
(append nil))
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 08beef7..e6c4630 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -310,7 +310,7 @@ You can control what lines will be unwrapped by frobbing
`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max',
indicating the minimum and maximum length of an unwrapped citation line. If
NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((case-fold-search nil)
(inhibit-read-only t)
(cite-marks gnus-outlook-deuglify-cite-marks)
@@ -430,7 +430,7 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
"Repair a broken attribution line.
If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((attrib-start
(or
(gnus-outlook-repair-attribution-other)
@@ -442,7 +442,7 @@ If NODISPLAY is non-nil, don't redisplay the article
buffer."
(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
"Repair broken citations.
If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay)))
;; rearrange citations if an attribution line has been recognized
(if attrib-start
@@ -455,7 +455,7 @@ If NODISPLAY is non-nil, don't redisplay the article
buffer."
Treat \"smartquotes\", unwrap lines, repair attribution and
rearrange citation. If NODISPLAY is non-nil, don't redisplay the
article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
;; apply treatment of dumb quotes
(gnus-article-treat-smartquotes)
;; repair wrapped cited lines
@@ -467,7 +467,7 @@ article buffer."
;;;###autoload
(defun gnus-article-outlook-deuglify-article ()
"Deuglify broken Outlook (Express) articles and redisplay."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-outlook-deuglify-article nil))
(provide 'deuglify)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c9afa3a..435ccab 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1823,7 +1823,7 @@ Initialized from `text-mode-syntax-table'.")
(defun article-hide-headers (&optional _arg _delete)
"Hide unwanted headers and possibly sort them as well."
- (interactive)
+ (interactive nil gnus-article-mode)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
(let ((inhibit-read-only t)
@@ -1891,7 +1891,7 @@ Initialized from `text-mode-syntax-table'.")
"Toggle hiding of headers that aren't very interesting.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
(not gnus-show-all-headers))
(save-excursion
@@ -2050,7 +2050,7 @@ always hide."
(defun article-normalize-headers ()
"Make all header lines 40 characters long."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((inhibit-read-only t)
column)
(save-excursion
@@ -2086,7 +2086,7 @@ iso-8859-1 character map in an attempt to provide more
quoting
characters. If you see something like \\222 or \\264 where
you're expecting some kind of apostrophe or quotation mark, then
try this wash."
- (interactive)
+ (interactive nil gnus-article-mode)
(article-translate-strings gnus-article-smartquotes-map))
(define-obsolete-function-alias 'article-treat-dumbquotes
#'article-treat-smartquotes "27.1")
@@ -2095,7 +2095,7 @@ try this wash."
(defun article-treat-non-ascii ()
"Translate many Unicode characters into their ASCII equivalents."
- (interactive)
+ (interactive nil gnus-article-mode)
(require 'org-entities)
(let ((table (make-char-table nil)))
(dolist (elem org-entities)
@@ -2138,7 +2138,7 @@ MAP is an alist where the elements are on the form
(\"from\" \"to\")."
(defun article-treat-overstrike ()
"Translate overstrikes into bold text."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(when (article-goto-body)
(let ((inhibit-read-only t))
@@ -2166,7 +2166,7 @@ MAP is an alist where the elements are on the form
(\"from\" \"to\")."
(defun article-treat-ansi-sequences ()
"Translate ANSI SGR control sequences into overlays or extents."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(when (article-goto-body)
(require 'ansi-color)
@@ -2178,7 +2178,7 @@ MAP is an alist where the elements are on the form
(\"from\" \"to\")."
"Unfold folded message headers.
Only the headers that fit into the current window width will be
unfolded."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (length)
(while (not (eobp))
@@ -2204,7 +2204,7 @@ unfolded."
(defun gnus-article-treat-fold-headers ()
"Fold message headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(while (not (eobp))
(save-restriction
@@ -2214,7 +2214,7 @@ unfolded."
(defun gnus-treat-smiley ()
"Toggle display of textual emoticons (\"smileys\") as small graphical icons."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'smiley gnus-article-wash-types)
(gnus-delete-images 'smiley)
@@ -2227,7 +2227,7 @@ unfolded."
(defun gnus-article-remove-images ()
"Remove all images from the article buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(save-restriction
(widen)
@@ -2239,7 +2239,7 @@ unfolded."
(defun gnus-article-show-images ()
"Show any images that are in the HTML-rendered article buffer.
This only works if the article in question is HTML."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(save-restriction
(widen)
@@ -2255,7 +2255,7 @@ This only works if the article in question is HTML."
(defun gnus-article-treat-fold-newsgroups ()
"Fold the Newsgroups and Followup-To message headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(while (gnus-article-goto-header "newsgroups\\|followup-to")
(save-restriction
@@ -2279,7 +2279,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
If ARG is non-nil and not a number, toggle
`gnus-article-truncate-lines' too. If ARG is a number, truncate
long lines if and only if arg is positive."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(cond
((and (numberp arg) (> arg 0))
(setq gnus-article-truncate-lines t))
@@ -2298,7 +2298,7 @@ long lines if and only if arg is positive."
(defun gnus-article-treat-body-boundary ()
"Place a boundary line at the end of the headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(when (and gnus-body-boundary-delimiter
(> (length gnus-body-boundary-delimiter) 0))
(gnus-with-article-headers
@@ -2317,7 +2317,7 @@ long lines if and only if arg is positive."
"Fill lines that are wider than the window width or `fill-column'.
If WIDTH (interactively, the numeric prefix), use that as the
fill width."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(save-excursion
(let* ((inhibit-read-only t)
(window-width (window-width (get-buffer-window (current-buffer))))
@@ -2341,7 +2341,7 @@ fill width."
(defun article-capitalize-sentences ()
"Capitalize the first word in each sentence."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t)
(paragraph-start "^[\n\^L]"))
@@ -2352,7 +2352,7 @@ fill width."
(defun article-remove-cr ()
"Remove trailing CRs and then translate remaining CRs into LFs."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-min))
@@ -2364,7 +2364,7 @@ fill width."
(defun article-remove-trailing-blank-lines ()
"Remove all trailing blank lines from the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-max))
@@ -2383,7 +2383,7 @@ fill width."
(defun article-display-face (&optional force)
"Display any Face headers in the header."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(let ((wash-face-p buffer-read-only))
(gnus-with-article-headers
;; When displaying parts, this function can be called several times on
@@ -2431,7 +2431,7 @@ fill width."
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(let ((wash-face-p buffer-read-only)) ;; When type `W f'
(gnus-with-article-headers
;; Delete the old process, if any.
@@ -2493,7 +2493,7 @@ fill width."
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t)
(mail-parse-charset gnus-newsgroup-charset)
@@ -2505,7 +2505,7 @@ fill width."
(defun article-decode-charset (&optional prompt)
"Decode charset-encoded text in the article.
If PROMPT (the prefix), prompt for a coding system to use."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((inhibit-point-motion-hooks t) (case-fold-search t)
(inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
@@ -2627,7 +2627,7 @@ Mail-Reply-To: and Mail-Followup-To:."
If FORCE, decode the article whether it is marked as quoted-printable
or not.
If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
+ (interactive (list 'force current-prefix-arg) gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2655,7 +2655,7 @@ If READ-CHARSET, ask for a coding system."
"Translate a base64 article.
If FORCE, decode the article whether it is marked as base64 not.
If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
+ (interactive (list 'force current-prefix-arg) gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2687,7 +2687,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-decode-HZ ()
"Translate a HZ-encoded article."
- (interactive)
+ (interactive nil gnus-article-mode)
(require 'rfc1843)
(save-excursion
(let ((inhibit-read-only t))
@@ -2695,7 +2695,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-unsplit-urls ()
"Remove the newlines that some other mailers insert into URLs."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-min))
@@ -2707,7 +2707,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-wash-html ()
"Format an HTML article."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((handles nil)
(inhibit-read-only t))
(when (gnus-buffer-live-p gnus-original-article-buffer)
@@ -3041,7 +3041,7 @@ This command creates temporary files to pass HTML
contents including
images if any to the browser, and deletes them when exiting the group
\(if you want)."
;; Cf. `mm-w3m-safe-url-regexp'
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(if arg
(gnus-summary-show-article)
(let ((gnus-visible-headers
@@ -3078,7 +3078,7 @@ images if any to the browser, and deletes them when
exiting the group
(defun article-hide-list-identifiers ()
"Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((inhibit-point-motion-hooks t)
(regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
(inhibit-read-only t))
@@ -3100,7 +3100,7 @@ The `gnus-list-identifiers' variable specifies what to
do."
"Toggle hiding of any PEM headers and signatures in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'pem arg)
(save-excursion
(let ((inhibit-read-only t) end)
@@ -3126,7 +3126,7 @@ always hide."
(defun article-strip-banner ()
"Strip the banners specified by the `banner' group parameter and by
`gnus-article-address-banner-alist'."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(save-restriction
(let ((inhibit-point-motion-hooks t))
@@ -3175,7 +3175,7 @@ always hide."
(defun article-babel ()
"Translate article using an online translation service."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(require 'babel)
(gnus-with-article-buffer
(when (article-goto-body)
@@ -3192,7 +3192,7 @@ always hide."
"Hide the signature in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'signature arg)
(save-excursion
(save-restriction
@@ -3204,7 +3204,7 @@ always hide."
(defun article-strip-headers-in-body ()
"Strip offensive headers from bodies."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(article-goto-body)
(let ((case-fold-search t))
@@ -3213,7 +3213,7 @@ always hide."
(defun article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3255,7 +3255,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-multiple-blank-lines ()
"Replace consecutive blank lines with one empty line."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3274,7 +3274,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-leading-space ()
"Remove all white space from the beginning of the lines in the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3284,7 +3284,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-trailing-space ()
"Remove all white space from the end of the lines in the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3294,14 +3294,14 @@ Point is left at the beginning of the narrowed-to
region."
(defun article-strip-blank-lines ()
"Strip leading, trailing and multiple blank lines."
- (interactive)
+ (interactive nil gnus-article-mode)
(article-strip-leading-blank-lines)
(article-remove-trailing-blank-lines)
(article-strip-multiple-blank-lines))
(defun article-strip-all-blank-lines ()
"Strip all blank lines."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3433,7 +3433,7 @@ lines forward."
"Convert DATE date to TYPE in the current article.
The default type is `ut'. See `gnus-article-date-headers' for
possible values."
- (interactive (list 'ut t))
+ (interactive (list 'ut t) gnus-article-mode)
(let* ((case-fold-search t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
@@ -3677,29 +3677,29 @@ possible values."
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'local highlight))
(defun article-date-english (&optional highlight)
"Convert the current article date to something that is proper English."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'english highlight))
(defun article-date-original (&optional highlight)
"Convert the current article date to what it was originally.
This is only useful if you have used some other date conversion
function and want to see what the date was before converting."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'original highlight))
(defun article-date-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'lapsed highlight))
(defun article-date-combined-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'combined-lapsed highlight))
(defun article-update-date-lapsed ()
@@ -3748,7 +3748,7 @@ function and want to see what the date was before
converting."
"Start a timer to update the Date headers in the article buffers.
The numerical prefix says how frequently (in seconds) the function
is to run."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(unless n
(setq n 1))
(gnus-stop-date-timer)
@@ -3757,7 +3757,7 @@ is to run."
(defun gnus-stop-date-timer ()
"Stop the Date timer."
- (interactive)
+ (interactive nil gnus-article-mode)
(when article-lapsed-timer
(cancel-timer article-lapsed-timer)
(setq article-lapsed-timer nil)))
@@ -3765,12 +3765,12 @@ is to run."
(defun article-date-user (&optional highlight)
"Convert the current article date to the user-defined format.
This format is defined by the `gnus-article-time-format' variable."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'user-defined highlight))
(defun article-date-iso8601 (&optional highlight)
"Convert the current article date to ISO8601."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'iso8601 highlight))
(defmacro gnus-article-save-original-date (&rest forms)
@@ -3803,7 +3803,7 @@ This format is defined by the `gnus-article-time-format'
variable."
(defun article-remove-leading-whitespace ()
"Remove excessive whitespace from all headers."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(save-restriction
(let ((inhibit-read-only t))
@@ -3814,7 +3814,7 @@ This format is defined by the `gnus-article-time-format'
variable."
(defun article-emphasize (&optional arg)
"Emphasize text according to `gnus-emphasis-alist'."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'emphasis arg)
(save-excursion
(let ((alist (or
@@ -4247,7 +4247,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defun article-verify-x-pgp-sig ()
"Verify X-PGP-Sig."
;; <https://ftp.isc.org/pub/pgpcontrol/FORMAT>
- (interactive)
+ (interactive nil gnus-article-mode)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(let ((sig (with-current-buffer gnus-original-article-buffer
(gnus-fetch-field "X-PGP-Sig")))
@@ -4321,7 +4321,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defun article-verify-cancel-lock ()
"Verify Cancel-Lock header."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(canlock-verify gnus-original-article-buffer)))
@@ -4330,7 +4330,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
`(defun ,(intern (format "gnus-%s" func))
(&optional interactive &rest args)
,(format "Run `%s' in the article buffer." func)
- (interactive (list t))
+ (interactive (list t) gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(if interactive
(call-interactively #',func)
@@ -4752,7 +4752,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(defun gnus-sticky-article (arg)
"Make the current article sticky.
If a prefix ARG is given, ask for a name for this sticky article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-summary-show-thread)
(gnus-summary-select-article nil nil 'pseudo)
(let (new-art-buf-name)
@@ -4796,7 +4796,7 @@ If a prefix ARG is given, ask for a name for this sticky
article buffer."
"Kill the given sticky article BUFFER.
If none is given, assume the current buffer and kill it if it has
`gnus-sticky-article-mode'."
- (interactive)
+ (interactive nil gnus-article-mode)
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
@@ -4806,7 +4806,7 @@ If none is given, assume the current buffer and kill it
if it has
(defun gnus-kill-sticky-article-buffers (arg)
"Kill all sticky article buffers.
If a prefix ARG is given, ask for confirmation."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(dolist (buf (gnus-buffers))
(with-current-buffer buf
(and (derived-mode-p 'gnus-sticky-article-mode)
@@ -4948,7 +4948,7 @@ General format specifiers can also be used. See Info node
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
- (interactive)
+ (interactive nil gnus-article-mode)
(with-current-buffer gnus-article-buffer
(let ((handles (or handles gnus-article-mime-handles))
(mail-parse-charset gnus-newsgroup-charset)
@@ -4965,7 +4965,7 @@ General format specifiers can also be used. See Info node
(defun gnus-article-jump-to-part (n)
"Jump to MIME part N."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((parts (with-current-buffer gnus-article-buffer
(length gnus-article-mime-handle-alist))))
(when (zerop parts)
@@ -5061,11 +5061,11 @@ and `gnus-mime-delete-part', and not provided at
run-time normally."
(defun gnus-mime-replace-part (file)
"Replace MIME part under point with an external body."
;; Useful if file has already been saved to disk
- (interactive
- (list
- (read-file-name "Replace MIME part with file: "
- (or mm-default-directory default-directory)
- nil t)))
+ (interactive (list
+ (read-file-name "Replace MIME part with file: "
+ (or mm-default-directory default-directory)
+ nil t))
+ gnus-article-mode)
(unless (file-regular-p (file-truename file))
(error "Can't replace part with %s, which isn't a regular file"
file))
@@ -5074,7 +5074,7 @@ and `gnus-mime-delete-part', and not provided at run-time
normally."
(defun gnus-mime-save-part-and-strip (&optional file event)
"Save the MIME part under point then replace it with an external body.
If FILE is given, use it for the external part."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5116,7 +5116,7 @@ The current article has a complicated MIME structure,
giving up..."))
(defun gnus-mime-delete-part (&optional event)
"Delete the MIME part under point.
Replace it with some information about the removed part."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
@@ -5165,7 +5165,7 @@ Deleting parts may malfunction or destroy the article;
continue? "))
(defun gnus-mime-save-part (&optional event)
"Save the MIME part under point."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
@@ -5175,7 +5175,7 @@ Deleting parts may malfunction or destroy the article;
continue? "))
(defun gnus-mime-pipe-part (&optional cmd event)
"Pipe the MIME part under point to a process.
Use CMD as the process."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
@@ -5184,7 +5184,7 @@ Use CMD as the process."
(defun gnus-mime-view-part (&optional event)
"Interactively choose a viewing method for the MIME part under point."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5214,7 +5214,7 @@ Use CMD as the process."
"Choose a MIME media type, and view the part as such.
If non-nil, PRED is a predicate to use during completion to limit the
available media-types."
- (interactive (list nil nil last-nonmenu-event))
+ (interactive (list nil nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(if event (mouse-set-point event))
(unless mime-type
@@ -5253,7 +5253,8 @@ available media-types."
"Put the MIME part under point into a new buffer.
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
are decompressed."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(unless handle
@@ -5309,7 +5310,8 @@ are decompressed."
(defun gnus-mime-print-part (&optional handle filename event)
"Print the MIME part under point."
(interactive
- (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+ (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)
+ gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5337,7 +5339,8 @@ are decompressed."
(defun gnus-mime-inline-part (&optional handle arg event)
"Insert the MIME part under point into the current buffer.
Compressed files like .gz and .bz2 are decompressed."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(if event (mouse-set-point event))
(gnus-article-check-buffer)
(let* ((inhibit-read-only t)
@@ -5435,7 +5438,8 @@ CHARSET may either be a string or a symbol."
(defun gnus-mime-view-part-as-charset (&optional handle arg event)
"Insert the MIME part under point into the current buffer using the
specified charset."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5475,7 +5479,7 @@ specified charset."
(defun gnus-mime-view-part-externally (&optional handle event)
"View the MIME part under point with an external viewer."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5497,7 +5501,7 @@ specified charset."
(defun gnus-mime-view-part-internally (&optional handle event)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5518,7 +5522,9 @@ If no internal viewer is available, use an external
viewer."
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at (point)."
(interactive
- (list (gnus-completing-read "Action" (mapcar #'car gnus-mime-action-alist)
t)))
+ (list (gnus-completing-read
+ "Action" (mapcar #'car gnus-mime-action-alist) t))
+ gnus-article-mode)
(gnus-article-check-buffer)
(let ((action-pair (assoc action gnus-mime-action-alist)))
(if action-pair
@@ -5611,62 +5617,62 @@ If INTERACTIVE, call FUNCTION interactively."
(defun gnus-article-pipe-part (n)
"Pipe MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-pipe-part))
(defun gnus-article-save-part (n)
"Save MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-save-part))
(defun gnus-article-interactively-view-part (n)
"View MIME part N interactively, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-interactively-view-part))
(defun gnus-article-copy-part (n)
"Copy MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-copy-part))
(defun gnus-article-view-part-as-charset (n)
"View MIME part N using a specified charset.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
(defun gnus-article-inline-part (n)
"Inline MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-inline-part))
(defun gnus-article-save-part-and-strip (n)
"Save MIME part N and replace it with an external body.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
(defun gnus-article-replace-part (n)
"Replace MIME part N with an external body.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
(defun gnus-article-delete-part (n)
"Delete MIME part N and add some information about the removed part.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-delete-part t))
(defun gnus-article-view-part-as-type (n)
"Choose a MIME media type, and view part N as such.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
(defun gnus-article-mime-match-handle-first (condition)
@@ -5693,7 +5699,7 @@ N is the numerical prefix."
"View MIME part N, which is the numerical prefix.
If the part is already shown, hide the part. If N is nil, view
all parts."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(or (numberp n) (setq n (gnus-article-mime-match-handle-first
gnus-article-mime-match-handle-function)))
@@ -6383,7 +6389,7 @@ Provided for backwards compatibility."
This function toggles the display when called interactively. Note that
buttons to be added to the header are only the ones that aren't inlined
in the body. Use `gnus-header-face-alist' to highlight buttons."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((case-fold-search t) buttons st)
(save-excursion
@@ -6488,7 +6494,7 @@ the coding cookie."
(defun gnus-narrow-to-page (&optional arg)
"Narrow the article buffer to a page.
If given a numerical ARG, move forward ARG pages."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(setq arg (if arg (prefix-numeric-value arg) 0))
(with-current-buffer gnus-article-buffer
(widen)
@@ -6541,7 +6547,7 @@ If given a numerical ARG, move forward ARG pages."
(defun gnus-article-goto-next-page ()
"Show the next page of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(when (gnus-article-next-page)
(goto-char (point-min))
(gnus-article-read-summary-keys nil ?n)))
@@ -6549,7 +6555,7 @@ If given a numerical ARG, move forward ARG pages."
(defun gnus-article-goto-prev-page ()
"Show the previous page of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
(gnus-article-read-summary-keys nil ?p)
(gnus-article-prev-page nil)))
@@ -6572,7 +6578,7 @@ If given a numerical ARG, move forward ARG pages."
"Show the next page of the current article.
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(move-to-window-line (- -1 scroll-margin))
(if (and (not (and gnus-article-over-scroll
(> (count-lines (window-start) (point-max))
@@ -6628,7 +6634,7 @@ specifies."
(defun gnus-article-prev-page (&optional lines)
"Show previous page of current article.
Argument LINES specifies lines to be scrolled down."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(move-to-window-line 0)
(if (and gnus-page-broken
(bobp)
@@ -6669,7 +6675,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(re-search-backward "[ \t]\\|^" (point-at-bol) t)
(re-search-forward "<?news:<?\\|<" (point-at-eol) t)
@@ -6681,7 +6687,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-show-summary ()
"Reconfigure windows to show summary buffer."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (not (gnus-buffer-live-p gnus-summary-buffer))
(error "There is no summary buffer for this article buffer")
(gnus-article-set-globals)
@@ -6691,7 +6697,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-describe-briefly ()
"Describe article mode commands briefly."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-message 6 "%s" (substitute-command-keys
"\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page
\\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show
summary \\[gnus-info-find-node]:Run Info
\\[gnus-article-describe-briefly]:This help")))
(defun gnus-article-check-buffer ()
@@ -6703,7 +6709,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-read-summary-keys (&optional _arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-check-buffer)
(let ((nosaves
'("q" "Q" "r" "m" "a" "f" "WDD" "WDW"
@@ -6814,7 +6820,7 @@ not have a face in `gnus-article-boring-faces'."
(ding))))))))
(defun gnus-article-read-summary-send-keys ()
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((unread-command-events (list ?S)))
(gnus-article-read-summary-keys)))
@@ -6822,7 +6828,8 @@ not have a face in `gnus-article-boring-faces'."
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
(interactive (list (let ((cursor-in-echo-area t))
- (read-key-sequence "Describe key: "))))
+ (read-key-sequence "Describe key: ")))
+ gnus-article-mode)
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
@@ -6844,7 +6851,8 @@ KEY is a string or a vector."
KEY is a string or a vector."
(interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-article-mode)
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
@@ -6871,7 +6879,7 @@ KEY is a string or a vector."
"Show a list of all defined keys, and their definitions.
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-check-buffer)
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
@@ -6930,7 +6938,7 @@ then we display only bindings that start with that
prefix."
"Start composing a reply mail to the current message.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((article (cdr gnus-article-current))
contents)
(if (not (and transient-mark-mode mark-active))
@@ -6948,14 +6956,14 @@ the entire article will be yanked."
"Start composing a wide reply mail to the current message.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-reply-with-original t))
(defun gnus-article-followup-with-original ()
"Compose a followup to the current article.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((article (cdr gnus-article-current))
contents)
(if (not (and transient-mark-mode mark-active))
@@ -6974,7 +6982,8 @@ the entire article will be yanked."
This means that signatures, cited text and (some) headers will be
hidden.
If given a prefix, show the hidden text instead."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (interactive (append (gnus-article-hidden-arg) (list 'force))
+ gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(article-hide-headers arg)
(article-hide-list-identifiers)
@@ -7269,7 +7278,7 @@ This is an extended text-mode.
This will have permanent effect only in mail groups.
If FORCE is non-nil, allow editing of articles even in read-only
groups."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
@@ -7302,7 +7311,7 @@ groups."
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start))
@@ -7336,7 +7345,7 @@ groups."
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
- (interactive)
+ (interactive nil gnus-article-mode)
(when (or (not (buffer-modified-p))
(yes-or-no-p "Article modified; kill anyway? "))
(let ((curbuf (current-buffer))
@@ -7357,7 +7366,7 @@ groups."
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(goto-char (point-min))
(search-forward-regexp "^$" nil t)
@@ -7875,7 +7884,7 @@ HEADER is a regexp to match a header. For a fuller
explanation, see
"Check text under the mouse pointer for a callback function.
If the text under the mouse pointer has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive "e")
+ (interactive "e" gnus-article-mode)
(set-buffer (window-buffer (posn-window (event-start event))))
(let* ((pos (posn-point (event-start event)))
(data (get-text-property pos 'gnus-data))
@@ -7888,7 +7897,7 @@ call it with the value of the `gnus-data' text property."
"Check text at point for a callback function.
If the text at point has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(save-excursion
(when event
(mouse-set-point event))
@@ -7902,7 +7911,7 @@ This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-citation',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode)
(gnus-article-highlight-headers)
(gnus-article-highlight-citation force)
(gnus-article-highlight-signature)
@@ -7914,14 +7923,14 @@ do the highlighting. See the documentation for those
functions."
This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode)
(gnus-article-highlight-headers)
(gnus-article-highlight-signature)
(gnus-article-add-buttons))
(defun gnus-article-highlight-headers ()
"Highlight article headers as specified by `gnus-header-face-alist'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (regexp header-face field-face from hpoints fpoints)
(dolist (entry gnus-header-face-alist)
@@ -7955,7 +7964,7 @@ do the highlighting. See the documentation for those
functions."
"Highlight the signature in an article.
It does this by highlighting everything after
`gnus-signature-separator' using the face `gnus-signature'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t))
(save-restriction
@@ -7978,7 +7987,7 @@ It does this by highlighting everything after
"Find external references in the article and make buttons of them.
\"External references\" are things like Message-IDs and URLs, as
specified by `gnus-button-alist'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t)
(case-fold-search t)
@@ -8072,7 +8081,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
;; Add buttons to the head of an article.
(defun gnus-article-add-buttons-to-head ()
"Add buttons to the head of the article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (beg end)
(dolist (entry gnus-header-button-alist)
@@ -8120,7 +8129,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-string)))
(when data
@@ -8236,7 +8245,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-button-patch (library line)
"Visit an Emacs Lisp library LIBRARY on line LINE."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((file (locate-library (file-name-nondirectory library))))
(unless file
(error "Couldn't find library %s" library))
@@ -8428,7 +8437,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
@@ -8436,7 +8445,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-button-prev-page (&optional _args _more-args)
"Go to the prev page."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
@@ -8460,7 +8469,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-article-button-next-page (_arg)
"Go to the next page."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
@@ -8468,7 +8477,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-article-button-prev-page (_arg)
"Go to the prev page."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
@@ -8602,9 +8611,10 @@ For example:
(list
(or gnus-article-encrypt-protocol
(gnus-completing-read "Encrypt protocol"
- (mapcar #'car
gnus-article-encrypt-protocol-alist)
- t))
- current-prefix-arg))
+ (mapcar #'car gnus-article-encrypt-protocol-alist)
+ t))
+ current-prefix-arg)
+ gnus-article-mode)
;; User might hit `K E' instead of `K e', so prompt once.
(when (and gnus-article-encrypt-protocol
gnus-novice-user)
@@ -8728,7 +8738,7 @@ For example:
(defun gnus-mime-security-button-menu (event prefix)
"Construct a context-sensitive menu of security commands."
- (interactive "e\nP")
+ (interactive "e\nP" gnus-article-mode)
(save-window-excursion
(let ((pos (event-start event)))
(select-window (posn-window pos))
@@ -8885,12 +8895,12 @@ For example:
(defun gnus-mime-security-save-part ()
"Save the security part under point."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-mime-security-run-function 'mm-save-part))
(defun gnus-mime-security-pipe-part ()
"Pipe the security part under point to a process."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-mime-security-run-function 'mm-pipe-part))
(provide 'gnus-art)
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index bc41d5b..8c2a928 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -168,7 +168,7 @@ So the cdr of each bookmark is an alist too.")
;;;###autoload
(defun gnus-bookmark-set ()
"Set a bookmark for this article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-bookmark-maybe-load-default-file)
(if (or (not (derived-mode-p 'gnus-summary-mode))
(not gnus-article-current))
@@ -483,7 +483,7 @@ Gnus bookmarks names preceded by a \"*\" have annotations.
(defun gnus-bookmark-bmenu-toggle-infos (&optional show)
"Toggle whether details are shown in the Gnus bookmark list.
Optional argument SHOW means show them unconditionally."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(cond
(show
(setq gnus-bookmark-bmenu-toggle-infos nil)
@@ -649,14 +649,14 @@ reposition and try again, else return nil."
(defun gnus-bookmark-bmenu-show-details ()
"Show the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(let ((bookmark (gnus-bookmark-bmenu-bookmark)))
(if (gnus-bookmark-bmenu-check-position)
(gnus-bookmark-show-details bookmark))))
(defun gnus-bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(let ((inhibit-read-only t))
@@ -668,7 +668,7 @@ reposition and try again, else return nil."
(defun gnus-bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
- (interactive "P")
+ (interactive "P" gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(progn
@@ -683,7 +683,7 @@ Optional BACKUP means move up."
(defun gnus-bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(forward-line -1)
(if (gnus-bookmark-bmenu-check-position)
(progn
@@ -695,7 +695,7 @@ Optional BACKUP means move up."
"Mark Gnus bookmark on this line to be deleted.
To carry out the deletions that you've marked, use
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(let ((inhibit-read-only t))
@@ -708,7 +708,7 @@ To carry out the deletions that you've marked, use
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(gnus-bookmark-bmenu-delete)
(forward-line -2)
(if (gnus-bookmark-bmenu-check-position)
@@ -720,7 +720,7 @@ To carry out the deletions that you've marked, use
You can mark bookmarks with the
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark]
command."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(if (gnus-bookmark-bmenu-check-position)
(let ((bmrk (gnus-bookmark-bmenu-bookmark))
(menu (current-buffer)))
@@ -730,13 +730,13 @@ command."
(bury-buffer menu))))
(defun gnus-bookmark-bmenu-select-by-mouse (event)
- (interactive "e")
+ (interactive "e" gnus-bookmark-bmenu-mode)
(mouse-set-point event)
(gnus-bookmark-bmenu-select))
(defun gnus-bookmark-bmenu-load ()
"Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(if (gnus-bookmark-bmenu-check-position)
(save-excursion
(save-window-excursion
@@ -745,7 +745,7 @@ command."
(defun gnus-bookmark-bmenu-execute-deletions ()
"Delete Gnus bookmarks marked with
\\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(message "Deleting Gnus bookmarks...")
(let ((hide-em gnus-bookmark-bmenu-toggle-infos)
(o-point (point))
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 5ed7319..34dba54 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -342,7 +342,7 @@ it's not cached."
"Enter the next N articles into the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles entered."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (out)
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-remove-process-mark article)
@@ -363,7 +363,7 @@ Returns the list of articles entered."
"Remove the next N articles from the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles removed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-cache-change-buffer gnus-newsgroup-name)
(let (out)
(dolist (article (gnus-summary-work-articles n))
@@ -388,7 +388,7 @@ Returns the list of articles removed."
(defun gnus-summary-insert-cached-articles ()
"Insert all the articles cached for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(cond
((not gnus-newsgroup-cached)
@@ -401,7 +401,7 @@ Returns the list of articles removed."
(defun gnus-summary-limit-include-cached ()
"Limit the summary buffer to articles that are cached."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if gnus-newsgroup-cached
(progn
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 96f1a7d..1f564f1 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -335,7 +335,7 @@ lines matches `message-cite-prefix-regexp' with the same
prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer)
(gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
@@ -459,7 +459,7 @@ frame width.
Sections that are heuristically interpreted as not being
text (i.e., computer code and the like) will not be folded."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
@@ -529,7 +529,8 @@ text (i.e., computer code and the like) will not be folded."
See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (interactive (append (gnus-article-hidden-arg) (list 'force))
+ gnus-article-mode gnus-summary-mode)
(gnus-set-format 'cited-opened-text-button t)
(gnus-set-format 'cited-closed-text-button t)
(with-current-buffer gnus-article-buffer
@@ -661,7 +662,8 @@ percent and at least `gnus-cite-hide-absolute' lines of the
body is
cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
- (interactive (append (gnus-article-hidden-arg) '(force)))
+ (interactive (append (gnus-article-hidden-arg) '(force))
+ gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-delete-wash-type 'cite)
(unless (gnus-article-check-hidden-text 'cite arg)
@@ -689,7 +691,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((article (cdr gnus-article-current)))
(unless (with-current-buffer gnus-summary-buffer
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index d8f48b1..0852f8e 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -337,7 +337,8 @@ category."))
(defun gnus-group-customize (group &optional topic)
"Edit the group or topic on the current line."
- (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
+ (interactive (list (gnus-group-group-name) (gnus-group-topic-name))
+ gnus-group-mode)
(let (info
(types (mapcar (lambda (entry)
`(cons :format "%v%h\n"
@@ -485,7 +486,7 @@ form, but who cares?"
(defun gnus-group-customize-done (&rest _ignore)
"Apply changes and bury the buffer."
- (interactive)
+ (interactive nil gnus-custom-mode)
(let ((params (widget-value gnus-custom-params)))
(if gnus-custom-topic
(gnus-topic-set-parameters gnus-custom-topic params)
@@ -829,7 +830,7 @@ eh?")))
"Customize score file FILE.
When called interactively, FILE defaults to the current score file.
This can be changed using the `\\[gnus-score-change-score-file]' command."
- (interactive (list gnus-current-score-file))
+ (interactive (list gnus-current-score-file) gnus-summary-mode)
(unless file
(error "No score file for %s" gnus-newsgroup-name))
(let ((scores (gnus-score-load file))
@@ -1000,7 +1001,7 @@ articles in the thread.
(defun gnus-agent-customize-category (category)
"Edit the CATEGORY."
- (interactive (list (gnus-category-name)))
+ (interactive (list (gnus-category-name)) gnus-custom-mode)
(let ((info (assq category gnus-category-alist))
(defaults (list nil '(agent-predicate . false)
(cons 'agent-enable-expiration
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 0cee01b..944fd97 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -76,10 +76,10 @@ DELAY is a string, giving the length of the time. Possible
values are:
The value of `message-draft-headers' determines which headers are
generated when the article is delayed. Remaining headers are
generated when the article is sent."
- (interactive
- (list (read-string
- "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in
[mhdwMY]): "
- gnus-delay-default-delay)))
+ (interactive (list (read-string
+ "Target date (YYYY-MM-DD), time (hh:mm), or length of
delay (units in [mhdwMY]): "
+ gnus-delay-default-delay))
+ message-mode)
;; Allow spell checking etc.
(run-hooks 'message-send-hook)
(let (num unit year month day hour minute deadline) ;; days
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 5270564..64eb639 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -214,7 +214,7 @@ There are currently two built-in format functions:
(defun gnus-summary-sort-by-schedule (&optional reverse)
"Sort nndiary summary buffers by schedule of appointments.
Optional prefix (or REVERSE argument) means sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'schedule reverse))
(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -322,7 +322,7 @@ This function checks that all NNDiary required headers are
present and
valid, and prompts for values / correction otherwise.
If ARG (or prefix) is non-nil, force prompting for all fields."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(mapcar
(lambda (head)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index ca2d57d..af0b782 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -124,7 +124,8 @@ filenames."
(mapcar
;; don't attach directories
(lambda (f) (if (file-directory-p f) nil f))
- (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
+ (nreverse (dired-map-over-marks (dired-get-filename) nil)))))
+ dired-mode)
(let ((destination nil)
(files-str nil)
(bufs nil))
@@ -178,7 +179,8 @@ filenames."
If ARG is non-nil, open it in a new buffer."
(interactive (list
(file-name-sans-versions (dired-get-filename) t)
- current-prefix-arg))
+ current-prefix-arg)
+ dired-mode)
(mailcap-parse-mailcaps)
(if (file-exists-p file-name)
(let (mime-type method)
@@ -216,7 +218,8 @@ that name. If PRINT-TO is a number, prompt the user for
the name
of the file to save in."
(interactive (list
(file-name-sans-versions (dired-get-filename) t)
- (ps-print-preprint current-prefix-arg)))
+ (ps-print-preprint current-prefix-arg))
+ dired-mode)
(mailcap-parse-mailcaps)
(cond
((file-directory-p file-name)
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index f68e9d6..9a0f213 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -71,7 +71,7 @@
(defun gnus-draft-toggle-sending (article)
"Toggle whether to send an article or not."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(if (gnus-draft-article-sendable-p article)
(progn
(push article gnus-newsgroup-unsendable)
@@ -83,7 +83,7 @@
(defun gnus-draft-edit-message ()
"Enter a mail/post buffer to edit and send the draft."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(group gnus-newsgroup-name))
(gnus-draft-check-draft-articles (list article))
@@ -109,7 +109,7 @@
(defun gnus-draft-send-message (&optional n)
"Send the current draft(s).
Obeys the standard process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((articles (gnus-summary-work-articles n))
(total (length articles))
article)
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 265edf4..3fd8bf5 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -104,7 +104,7 @@ The optional LAYOUT overrides the `edit-form' window
layout."
(defun gnus-edit-form-done ()
"Update changes and kill the current buffer."
- (interactive)
+ (interactive nil gnus-edit-form-mode)
(goto-char (point-min))
(let ((form (condition-case nil
(read (current-buffer))
@@ -115,7 +115,7 @@ The optional LAYOUT overrides the `edit-form' window
layout."
(defun gnus-edit-form-exit ()
"Kill the current buffer."
- (interactive)
+ (interactive nil gnus-edit-form-mode)
(let ((winconf gnus-prev-winconf))
(kill-buffer (current-buffer))
(set-window-configuration winconf)))
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index f69c2ed..c2e72ab 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -132,11 +132,12 @@ For instance, to insert an X-Face use
`gnus-random-x-face' as FUN
Files matching `gnus-x-face-omit-files' are not considered."
(interactive)
- (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$"
gnus-x-face-omit-files
- (lambda (file)
- (gnus-shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command
- (shell-quote-argument file))))))
+ (gnus--random-face-with-type
+ gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files
+ (lambda (file)
+ (gnus-shell-command-to-string
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file))))))
;;;###autoload
(defun gnus-insert-random-x-face-header ()
@@ -231,8 +232,8 @@ FILE should be a PNG file that's 48x48 and smaller than or
equal to
Files matching `gnus-face-omit-files' are not considered."
(interactive)
(gnus--random-face-with-type gnus-face-directory "\\.png$"
- gnus-face-omit-files
- 'gnus-convert-png-to-face))
+ gnus-face-omit-files
+ 'gnus-convert-png-to-face))
;;;###autoload
(defun gnus-insert-random-face-header ()
@@ -277,7 +278,6 @@ colors of the displayed X-Faces."
(defun gnus-grab-cam-x-face ()
"Grab a picture off the camera and make it into an X-Face."
- (interactive)
(shell-command "xawtv-remote snap ppm")
(let ((file nil))
(while (null (setq file (directory-files "/tftpboot/sparky/tmp"
@@ -289,13 +289,11 @@ colors of the displayed X-Faces."
(format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm
2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 |
pbmtoxbm | compface"
file null-device)
(current-buffer))
- ;;(sleep-for 3)
(delete-file file)
(buffer-string))))
(defun gnus-grab-cam-face ()
"Grab a picture off the camera and make it into an X-Face."
- (interactive)
(shell-command "xawtv-remote snap ppm")
(let ((file nil)
(tempfile (make-temp-file "gnus-face-" nil ".ppm"))
@@ -312,7 +310,6 @@ colors of the displayed X-Faces."
(gnus-fun-ppm-change-string))))
(setq result (gnus-face-from-file tempfile)))
(delete-file file)
- ;;(delete-file tempfile) ; FIXME why are we not deleting it?!
result))
(defun gnus-fun-ppm-change-string ()
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 9ea9e10..be57774 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -125,7 +125,7 @@ callback for `gravatar-retrieve'."
(defun gnus-treat-from-gravatar (&optional force)
"Display gravatar in the From header.
If gravatar is already displayed, remove it."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'from-gravatar gnus-article-wash-types)
(gnus-delete-images 'from-gravatar)
@@ -135,7 +135,7 @@ If gravatar is already displayed, remove it."
(defun gnus-treat-mail-gravatar (&optional force)
"Display gravatars in the Cc and To headers.
If gravatars are already displayed, remove them."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'mail-gravatar gnus-article-wash-types)
(gnus-delete-images 'mail-gravatar)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index e8b62a4..909391b 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1160,7 +1160,7 @@ The following commands are available:
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-group-mode)
(mouse-set-point e)
(gnus-group-read-group nil))
@@ -1241,7 +1241,8 @@ Also see the `gnus-group-use-permanent-levels' variable."
(or
(gnus-group-default-level nil t)
(gnus-group-default-list-level)
- gnus-level-subscribed))))
+ gnus-level-subscribed)))
+ gnus-group-mode)
(unless level
(setq level (car gnus-group-list-mode)
unread (cdr gnus-group-list-mode)))
@@ -1292,7 +1293,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
(defun gnus-group-list-level (level &optional all)
"List groups on LEVEL.
If ALL (the prefix), also list groups that have no unread articles."
- (interactive "nList groups on level: \nP")
+ (interactive "nList groups on level: \nP" gnus-group-mode)
(gnus-group-list-groups level all level))
(defun gnus-group-prepare-logic (group test)
@@ -1866,7 +1867,7 @@ If FIRST-TOO, the current line is also eligible as a
target."
(defun gnus-group-mark-group (n &optional unmark no-advance)
"Mark the current group."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((buffer-read-only nil)
group)
(while (and (> n 0)
@@ -1891,13 +1892,13 @@ If FIRST-TOO, the current line is also eligible as a
target."
(defun gnus-group-unmark-group (n)
"Remove the mark from the current group."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-mark-group n 'unmark)
(gnus-group-position-point))
(defun gnus-group-unmark-all-groups ()
"Unmark all groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(save-excursion
(mapc #'gnus-group-remove-mark gnus-group-marked))
(gnus-group-position-point))
@@ -1905,7 +1906,7 @@ If FIRST-TOO, the current line is also eligible as a
target."
(defun gnus-group-mark-region (unmark beg end)
"Mark all groups between point and mark.
If UNMARK, remove the mark instead."
- (interactive "P\nr")
+ (interactive "P\nr" gnus-group-mode)
(let ((num (count-lines beg end)))
(save-excursion
(goto-char beg)
@@ -1914,12 +1915,12 @@ If UNMARK, remove the mark instead."
(defun gnus-group-mark-buffer (&optional unmark)
"Mark all groups in the buffer.
If UNMARK, remove the mark instead."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-mark-region unmark (point-min) (point-max)))
(defun gnus-group-mark-regexp (regexp)
"Mark all groups that match some regexp."
- (interactive "sMark (regexp): ")
+ (interactive "sMark (regexp): " gnus-group-mode)
(let ((alist (cdr gnus-newsrc-alist))
group)
(save-excursion
@@ -2028,7 +2029,7 @@ number of the earliest articles in the group.
If the optional argument NO-ARTICLE is non-nil, no article will
be auto-selected upon group entry. If GROUP is non-nil, fetch
that group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((no-display (eq all 0))
(group (or group (gnus-group-group-name)))
number active marked entry)
@@ -2062,7 +2063,7 @@ If ALL is a positive number, fetch this number of the
latest
articles in the group.
If ALL is a negative number, fetch this number of the earliest
articles in the group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(gnus-group-read-group all t))
@@ -2081,7 +2082,7 @@ buffer. If GROUP is nil, use current group.
This might be useful if you want to toggle threading
before entering the group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'gnus-score)
(let (gnus-visual
gnus-score-find-score-files-function
@@ -2092,7 +2093,7 @@ before entering the group."
(defun gnus-group-visible-select-group (&optional all)
"Select the current group without hiding any articles."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-inhibit-limiting t))
(gnus-group-read-group all t)))
@@ -2101,7 +2102,7 @@ before entering the group."
You will actually be entered into a group that's a copy of
the current group; no changes you make while in this group will
be permanent."
- (interactive)
+ (interactive nil gnus-group-mode)
(require 'gnus-score)
(let* (gnus-visual
gnus-score-find-score-files-function gnus-apply-kill-hook
@@ -2333,7 +2334,8 @@ specified by `gnus-gmane-group-download-format'."
(list
(gnus-group-completing-read "Gmane group")
(read-number "Start article number: ")
- (read-number "How many articles: ")))
+ (read-number "How many articles: "))
+ gnus-group-mode)
(unless range (setq range 500))
(when (< range 1)
(error "Invalid range: %s" range))
@@ -2367,8 +2369,7 @@ Valid input formats include:
;; - The URLs should be added to `gnus-button-alist'. Probably we should
;; prompt the user to decide: "View via `browse-url' or in Gnus? "
;; (`gnus-read-ephemeral-gmane-group-url')
- (interactive
- (list (gnus-group-completing-read "Gmane URL")))
+ (interactive (list (gnus-group-completing-read "Gmane URL")) gnus-group-mode)
(let (group start range)
(cond
;; URLs providing `group', `start' and `range':
@@ -2543,7 +2544,8 @@ If PROMPT (the prefix) is a number, use the prompt
specified in
(or (and (stringp gnus-group-jump-to-group-prompt)
gnus-group-jump-to-group-prompt)
(let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
- (and (stringp p) p)))))))
+ (and (stringp p) p))))))
+ gnus-group-mode)
(when (equal group "")
(error "Empty group name"))
@@ -2612,7 +2614,7 @@ Return nil if GROUP is not found."
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group n t nil silent))
(defun gnus-group-next-unread-group (n &optional all level silent)
@@ -2624,7 +2626,7 @@ such group can be found, the next group with a level
higher than
LEVEL.
Returns the difference between N and the number of skips actually
made."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -2641,14 +2643,14 @@ made."
"Go to previous N'th newsgroup.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n) t))
(defun gnus-group-prev-unread-group (n)
"Go to previous N'th unread newsgroup.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n)))
(defun gnus-group-next-unread-group-same-level (n)
@@ -2656,7 +2658,7 @@ done."
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group n t (gnus-group-group-level))
(gnus-group-position-point))
@@ -2664,14 +2666,14 @@ done."
"Go to next N'th unread newsgroup on the same level.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n) t (gnus-group-group-level))
(gnus-group-position-point))
(defun gnus-group-best-unread-group (&optional exclude-group)
"Go to the group with the highest level.
If EXCLUDE-GROUP, do not go to that group."
- (interactive)
+ (interactive nil gnus-group-mode)
(goto-char (point-min))
(let ((best 100000)
unread best-point)
@@ -2711,7 +2713,7 @@ If EXCLUDE-GROUP, do not go to that group."
(defun gnus-group-first-unread-group ()
"Go to the first group with unread articles."
- (interactive)
+ (interactive nil gnus-group-mode)
(prog1
(let ((opoint (point))
unread)
@@ -2727,13 +2729,13 @@ If EXCLUDE-GROUP, do not go to that group."
(defun gnus-group-enter-server-mode ()
"Jump to the server buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-enter-server-buffer))
(defun gnus-group-make-group-simple (&optional group)
"Add a new newsgroup.
The user will be prompted for GROUP."
- (interactive (list (gnus-group-completing-read)))
+ (interactive (list (gnus-group-completing-read)) gnus-group-mode)
(gnus-group-make-group (gnus-group-real-name group)
(gnus-group-server group)
nil nil))
@@ -2749,7 +2751,8 @@ server."
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "Select method for new group (use tab for completion)")))
+ (gnus-read-method "Select method for new group (use tab for completion)"))
+ gnus-group-mode)
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
@@ -2794,7 +2797,7 @@ server."
(defun gnus-group-delete-groups (&optional arg)
"Delete the current group. Only meaningful with editable groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((n (length (gnus-group-process-prefix arg))))
(when (gnus-yes-or-no-p
(if (= n 1)
@@ -2809,8 +2812,8 @@ server."
If OLDP (the prefix), only delete articles that are \"old\",
according to the expiry settings. Note that this will delete old
not-expirable articles, too."
- (interactive (list (gnus-group-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-group-group-name) current-prefix-arg)
+ gnus-group-mode)
(let ((articles (gnus-uncompress-range (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
@@ -2829,9 +2832,8 @@ doing the deletion.
Note that you also have to specify FORCE if you want the group to
be removed from the server, even when it's empty."
- (interactive
- (list (gnus-group-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-group-group-name) current-prefix-arg)
+ gnus-group-mode)
(unless group
(error "No group to delete"))
(unless (gnus-check-backend-function 'request-delete-group group)
@@ -2865,7 +2867,8 @@ and NEW-NAME will be prompted for."
"Rename group to: "
(gnus-group-real-name group))
method (gnus-info-method (gnus-get-info group)))
- (list group (gnus-group-prefixed-name new-name method))))
+ (list group (gnus-group-prefixed-name new-name method)))
+ gnus-group-mode)
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This back end does not support renaming groups"))
@@ -2911,7 +2914,7 @@ and NEW-NAME will be prompted for."
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((part (or part 'info))
info)
(unless group
@@ -2950,12 +2953,12 @@ and NEW-NAME will be prompted for."
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-group group 'method))
(defun gnus-group-edit-group-parameters (group)
"Edit the group parameters of GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-group group 'params))
(defun gnus-group-edit-group-done (part group form)
@@ -2993,14 +2996,16 @@ and NEW-NAME will be prompted for."
(defun gnus-group-make-useful-group (group method)
"Create one of the groups described in `gnus-useful-groups'."
(interactive
- (let ((entry (assoc (gnus-completing-read "Create group"
- (mapcar #'car gnus-useful-groups)
- t)
+ (let ((entry (assoc (gnus-completing-read
+ "Create group"
+ (mapcar #'car gnus-useful-groups)
+ t)
gnus-useful-groups)))
(list (cadr entry)
- ;; Don't use `caddr' here since macros within the `interactive'
- ;; form won't be expanded.
- (car (cddr entry)))))
+ ;; Don't use `caddr' here since macros within the
+ ;; `interactive' form won't be expanded.
+ (car (cddr entry))))
+ gnus-group-mode)
(setq method (copy-tree method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
@@ -3014,7 +3019,7 @@ group already exists:
- if not given, and error is signaled,
- if t, stay silent,
- if anything else, just print a message."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
(file (nnheader-find-etc-directory "gnus-tut.txt" t)))
(if (gnus-group-entry name)
@@ -3040,9 +3045,9 @@ group already exists:
"Create a group that uses a single file as the source.
If called with a prefix argument, ask for the file type."
- (interactive
- (list (read-file-name "File name: ")
- (and current-prefix-arg 'ask)))
+ (interactive (list (read-file-name "File name: ")
+ (and current-prefix-arg 'ask))
+ gnus-group-mode)
(when (eq type 'ask)
(let ((err "")
char found)
@@ -3077,7 +3082,7 @@ If called with a prefix argument, ask for the file type."
(defun gnus-group-make-web-group (&optional solid)
"Create an ephemeral nnweb group.
If SOLID (the prefix), create a solid group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'nnweb)
(let* ((group
(if solid (gnus-read-group "Group name: ")
@@ -3117,7 +3122,7 @@ If SOLID (the prefix), create a solid group."
(defun gnus-group-make-rss-group (&optional url)
"Given a URL, discover if there is an RSS feed.
If there is, use Gnus to create an nnrss group"
- (interactive)
+ (interactive nil gnus-group-mode)
(require 'nnrss)
(if (not url)
(setq url (read-from-minibuffer "URL to Search for RSS: ")))
@@ -3158,8 +3163,8 @@ If there is, use Gnus to create an nnrss group"
The user will be prompted for a directory. The contents of this
directory will be used as a newsgroup. The directory should contain
mail messages or news articles in files that have numeric names."
- (interactive
- (list (read-directory-name "Create group from directory: ")))
+ (interactive (list (read-directory-name "Create group from directory: "))
+ gnus-group-mode)
(unless (file-exists-p dir)
(error "No such directory"))
(unless (file-directory-p dir)
@@ -3192,7 +3197,7 @@ prefix arg NO-PARSE means that Gnus should not parse the
search
query before passing it to the underlying search engine. A
non-nil SPECS arg must be an alist with `search-query-spec' and
`search-group-spec' keys, and skips all prompting."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
@@ -3246,7 +3251,7 @@ prefix arg NO-PARSE means that Gnus should not parse the
search
query before passing it to the underlying search engine. A
non-nil SPECS arg must be an alist with `search-query-spec' and
`search-group-spec' keys, and skips all prompting."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let* ((group-spec
(or (cdr (assq 'search-group-spec specs))
(cdr (assq 'nnir-group-spec specs))
@@ -3286,10 +3291,10 @@ non-nil SPECS arg must be an alist with
`search-query-spec' and
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
- (interactive
- (list current-prefix-arg
- (gnus-group-completing-read "Add to virtual group"
- nil t "nnvirtual:")))
+ (interactive (list current-prefix-arg
+ (gnus-group-completing-read "Add to virtual group"
+ nil t "nnvirtual:"))
+ gnus-group-mode)
(unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
(error "%s is not an nnvirtual group" vgroup))
(gnus-close-group vgroup)
@@ -3307,7 +3312,7 @@ non-nil SPECS arg must be an alist with
`search-query-spec' and
(defun gnus-group-make-empty-virtual (group)
"Create a new, fresh, empty virtual group."
- (interactive "sCreate new, empty virtual group: ")
+ (interactive "sCreate new, empty virtual group: " gnus-group-mode)
(let* ((method (list 'nnvirtual "^$"))
(pgroup (gnus-group-prefixed-name group method)))
;; Check whether it exists already.
@@ -3321,7 +3326,7 @@ non-nil SPECS arg must be an alist with
`search-query-spec' and
(defun gnus-group-enter-directory (dir)
"Enter an ephemeral nneething group."
- (interactive "DDirectory to read: ")
+ (interactive "DDirectory to read: " gnus-group-mode)
(let* ((method (list 'nneething dir '(nneething-read-only t)))
(leaf (gnus-group-prefixed-name
(file-name-nondirectory (directory-file-name dir))
@@ -3336,7 +3341,7 @@ non-nil SPECS arg must be an alist with
`search-query-spec' and
(defun gnus-group-expunge-group (group)
"Expunge deleted articles in current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-expunge-group (car method)))
@@ -3348,7 +3353,7 @@ non-nil SPECS arg must be an alist with
`search-query-spec' and
(defun gnus-group-nnimap-edit-acl (group)
"Edit the Access Control List of current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((mailbox (gnus-group-real-name group)) method acl)
(unless group
(error "No group on current line"))
@@ -3395,7 +3400,8 @@ Editing the access control list for `%s'.
When used interactively, the sorting function used will be
determined by the `gnus-group-sort-function' variable.
If REVERSE (the prefix), reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
+ (interactive (list gnus-group-sort-function current-prefix-arg)
+ gnus-group-mode)
(funcall gnus-group-sort-alist-function
(gnus-make-sort-function func) reverse)
(gnus-group-unmark-all-groups)
@@ -3428,56 +3434,57 @@ value is disregarded."
(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
"Sort the group buffer alphabetically by group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
(defun gnus-group-sort-groups-by-real-name (&optional reverse)
"Sort the group buffer alphabetically by real (unprefixed) group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
(defun gnus-group-sort-groups-by-unread (&optional reverse)
"Sort the group buffer by number of unread articles.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
(defun gnus-group-sort-groups-by-level (&optional reverse)
"Sort the group buffer by group level.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
(defun gnus-group-sort-groups-by-score (&optional reverse)
"Sort the group buffer by group score.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
(defun gnus-group-sort-groups-by-rank (&optional reverse)
"Sort the group buffer by group rank.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-groups-by-method (&optional reverse)
"Sort the group buffer alphabetically by back end name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
(defun gnus-group-sort-groups-by-server (&optional reverse)
"Sort the group buffer alphabetically by server name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
;;; Selected group sorting.
(defun gnus-group-sort-selected-groups (n func &optional reverse)
"Sort the process/prefixed groups."
- (interactive (list current-prefix-arg gnus-group-sort-function))
+ (interactive (list current-prefix-arg gnus-group-sort-function)
+ gnus-group-mode)
(let ((groups (gnus-group-process-prefix n)))
(funcall gnus-group-sort-selected-function
groups (gnus-make-sort-function func) reverse)
@@ -3509,49 +3516,49 @@ If REVERSE is non-nil, reverse the sorting."
"Sort the group buffer alphabetically by group name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
"Sort the group buffer alphabetically by real group name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
"Sort the group buffer by number of unread articles.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
"Sort the group buffer by group level.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
"Sort the group buffer by group score.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
"Sort the group buffer by group rank.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
"Sort the group buffer alphabetically by back end name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
;;; Sorting predicates.
@@ -3609,7 +3616,7 @@ sort in reverse order."
(defun gnus-group-clear-data (&optional arg)
"Clear all marks and read ranges from the current group.
Obeys the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when (gnus-y-or-n-p "Really clear data? ")
(gnus-group-iterate arg
(lambda (group)
@@ -3621,7 +3628,7 @@ Obeys the process/prefix convention."
(defun gnus-group-clear-data-on-native-groups ()
"Clear all marks and read ranges from all native groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
(let ((alist (cdr gnus-newsrc-alist))
info)
@@ -3665,7 +3672,7 @@ caught up. If ALL is non-nil, marked articles will also
be marked as
read. Cross references (Xref: header) of articles are ignored.
The number of newsgroups that this function was unable to catch
up is returned."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((groups (gnus-group-process-prefix n))
(ret 0)
group)
@@ -3704,7 +3711,7 @@ up is returned."
(defun gnus-group-catchup-current-all (&optional n)
"Mark all articles in current newsgroup as read.
Cross references (Xref: header) of articles are ignored."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-catchup-current n 'all))
(declare-function gnus-sequence-of-unread-articles "gnus-sum" (group))
@@ -3751,7 +3758,7 @@ or nil if no action could be taken."
(defun gnus-group-expire-articles (&optional n)
"Expire all expirable articles in the current newsgroup.
Uses the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((groups (gnus-group-process-prefix n))
group)
(unless groups
@@ -3797,7 +3804,7 @@ Uses the process/prefix convention."
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
- (interactive)
+ (interactive nil gnus-group-mode)
(save-excursion
(gnus-message 5 "Expiring...")
(let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
@@ -3821,7 +3828,8 @@ Uses the process/prefix convention."
(if (string-match "^\\s-*$" s)
(int-to-string (or (gnus-group-group-level)
gnus-level-default-subscribed))
- s))))))
+ s)))))
+ gnus-group-mode)
(unless (and (>= level 1) (<= level gnus-level-killed))
(error "Invalid level: %d" level))
(dolist (group (gnus-group-process-prefix n))
@@ -3837,18 +3845,18 @@ Uses the process/prefix convention."
(defun gnus-group-unsubscribe (&optional n)
"Unsubscribe the current group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-unsubscribe-current-group n 'unsubscribe))
(defun gnus-group-subscribe (&optional n)
"Subscribe the current group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-unsubscribe-current-group n 'subscribe))
(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
"Toggle subscription of the current group.
If given numerical prefix, toggle the N next groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
(gnus-group-unsubscribe-group
@@ -3871,7 +3879,8 @@ If given numerical prefix, toggle the N next groups."
Killed newsgroups are subscribed. If SILENT, don't try to update the
group line."
(interactive (list (gnus-group-completing-read
- nil nil (gnus-read-active-file-p))))
+ nil nil (gnus-read-active-file-p)))
+ gnus-group-mode)
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "\\`[ \t]*\\'" group)
@@ -3905,7 +3914,7 @@ group line."
"Move the current newsgroup up N places.
If given a negative prefix, move down instead. The difference between
N and the number of steps taken is returned."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(unless (gnus-group-group-name)
(error "No group on current line"))
(gnus-group-kill-group 1)
@@ -3917,7 +3926,8 @@ N and the number of steps taken is returned."
(defun gnus-group-kill-all-zombies (&optional dummy)
"Kill all zombie newsgroups.
The optional DUMMY should always be nil."
- (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
+ (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))
+ gnus-group-mode)
(unless dummy
(setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
(setq gnus-zombie-list nil)
@@ -3927,7 +3937,7 @@ The optional DUMMY should always be nil."
(defun gnus-group-kill-region (begin end)
"Kill newsgroups in current region (excluding current point).
The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
- (interactive "r")
+ (interactive "r" gnus-group-mode)
(let ((lines
;; Count lines.
(save-excursion
@@ -3949,7 +3959,7 @@ However, only groups that were alive can be yanked;
already killed
groups or zombie groups can't be yanked.
The return value is the name of the group that was killed, or a list
of groups killed."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((buffer-read-only nil)
(groups (gnus-group-process-prefix n))
group entry level out)
@@ -4009,7 +4019,7 @@ of groups killed."
The numeric ARG specifies how many newsgroups are to be yanked. The
name of the newsgroup yanked is returned, or (if several groups are
yanked) a list of yanked groups is returned."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(setq arg (or arg 1))
(let (info group prev out)
(while (>= (cl-decf arg) 0)
@@ -4034,7 +4044,7 @@ yanked) a list of yanked groups is returned."
(defun gnus-group-kill-level (level)
"Kill all groups that is on a certain LEVEL."
- (interactive "nKill all groups on level: ")
+ (interactive "nKill all groups on level: " gnus-group-mode)
(cond
((= level gnus-level-zombie)
(setq gnus-killed-list
@@ -4065,7 +4075,7 @@ yanked) a list of yanked groups is returned."
"List all newsgroups with level ARG or lower.
Default is `gnus-level-unsubscribed', which lists all subscribed and most
unsubscribed groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
;; Redefine this to list ALL killed groups if prefix arg used.
@@ -4074,7 +4084,7 @@ unsubscribed groups."
"List all killed newsgroups in the group buffer.
If ARG is non-nil, list ALL killed groups known to Gnus. This may
entail asking the server for the groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
;; Find all possible killed newsgroups if arg.
(when arg
(gnus-get-killed-groups))
@@ -4088,7 +4098,7 @@ entail asking the server for the groups."
(defun gnus-group-list-zombies ()
"List all zombie newsgroups in the group buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(if (not gnus-zombie-list)
(gnus-message 6 "No zombie groups")
(let (gnus-group-list-mode)
@@ -4099,7 +4109,7 @@ entail asking the server for the groups."
(defun gnus-group-list-active ()
"List all groups that are available from the server(s)."
- (interactive)
+ (interactive nil gnus-group-mode)
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t)
@@ -4121,7 +4131,7 @@ entail asking the server for the groups."
(defun gnus-activate-all-groups (level)
"Activate absolutely all groups."
- (interactive (list gnus-level-unsubscribed))
+ (interactive (list gnus-level-unsubscribed) gnus-group-mode)
(let ((gnus-activate-level level)
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
@@ -4133,7 +4143,7 @@ re-scanning. If ARG is non-nil and not a number, this
will force
\"hard\" re-reading of the active files from all servers.
If ONE-LEVEL is not nil, then re-scan only the specified level,
otherwise all levels below ARG will be scanned too."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'nnmail)
(let ((gnus-inhibit-demon t)
;; Binding this variable will inhibit multiple fetchings
@@ -4163,7 +4173,7 @@ otherwise all levels below ARG will be scanned too."
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked.
If DONT-SCAN is non-nil, scan non-activated groups as well."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
@@ -4208,7 +4218,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
- (interactive (list current-prefix-arg (gnus-group-group-name)))
+ (interactive (list current-prefix-arg (gnus-group-group-name))
+ gnus-group-mode)
(let* ((method (gnus-find-method-for-group group))
(mname (gnus-group-prefixed-name "" method))
desc)
@@ -4230,7 +4241,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-group-describe-all-groups (&optional force)
"Pop up a buffer with descriptions of all newsgroups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when force
(setq gnus-description-hashtb nil))
(when (not (or gnus-description-hashtb
@@ -4255,7 +4266,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-group-apropos (regexp &optional search-description)
"List all newsgroups that have names that match a regexp."
- (interactive "sGnus apropos (regexp): ")
+ (interactive "sGnus apropos (regexp): " gnus-group-mode)
(let ((prev "")
(obuf (current-buffer))
groups des)
@@ -4294,7 +4305,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
(defun gnus-group-description-apropos (regexp)
"List all newsgroups that have names or descriptions that match REGEXP."
- (interactive "sGnus description apropos (regexp): ")
+ (interactive "sGnus description apropos (regexp): " gnus-group-mode)
(when (not (or gnus-description-hashtb
(gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
@@ -4309,7 +4320,7 @@ If ALL, also list groups with no unread articles.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P\nsList newsgroups matching: ")
+ (interactive "P\nsList newsgroups matching: " gnus-group-mode)
;; First make sure active file has been read.
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
@@ -4324,7 +4335,7 @@ This command may read the active file."
If the prefix LEVEL is non-nil, it should be a number that says which
level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST."
- (interactive "P\nsList newsgroups matching: ")
+ (interactive "P\nsList newsgroups matching: " gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
@@ -4333,12 +4344,12 @@ If LOWEST, don't list groups with level lower than
LOWEST."
(defun gnus-group-save-newsrc (&optional force)
"Save the Gnus startup files.
If FORCE, force saving whether it is necessary or not."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-save-newsrc-file force))
(defun gnus-group-restart (&optional _arg)
"Force Gnus to read the .newsrc file."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (gnus-yes-or-no-p
(format "Are you sure you want to restart Gnus? "))
(gnus-save-newsrc-file)
@@ -4347,7 +4358,7 @@ If FORCE, force saving whether it is necessary or not."
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-read-init-file)
(gnus-message 5 "Read %s" gnus-init-file))
@@ -4355,7 +4366,7 @@ If FORCE, force saving whether it is necessary or not."
"Check bogus newsgroups.
If given a prefix, don't ask for confirmation before removing a bogus
group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
(gnus-group-list-groups))
@@ -4366,7 +4377,7 @@ With 1 C-u, use the `ask-server' method to query the
server for new
groups.
With 2 C-u's, use most complete method possible to query the server
for new groups, and subscribe the new groups as zombies."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
current-group)
(gnus-group-list-groups)
@@ -4379,7 +4390,7 @@ for new groups, and subscribe the new groups as zombies."
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If GROUP, edit that local kill file instead."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(setq gnus-current-kill-article article)
(gnus-kill-file-edit-file group)
(gnus-message 6 "Editing a %s kill file (Type %s to exit)"
@@ -4388,12 +4399,12 @@ If GROUP, edit that local kill file instead."
(defun gnus-group-edit-local-kill (article group)
"Edit a local kill file."
- (interactive (list nil (gnus-group-group-name)))
+ (interactive (list nil (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-global-kill article group))
(defun gnus-group-force-update ()
"Update `.newsrc' file."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-save-newsrc-file))
(defvar gnus-backlog-articles)
@@ -4402,7 +4413,7 @@ If GROUP, edit that local kill file instead."
"Suspend the current Gnus session.
In fact, cleanup buffers except for group mode buffer.
The hook `gnus-suspend-gnus-hook' is called before actually suspending."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-run-hooks 'gnus-suspend-gnus-hook)
(gnus-offer-save-summaries)
;; Kill Gnus buffers except for group mode buffer.
@@ -4425,14 +4436,14 @@ The hook `gnus-suspend-gnus-hook' is called before
actually suspending."
(defun gnus-group-clear-dribble ()
"Clear all information from the dribble buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-dribble-clear)
(gnus-message 7 "Cleared dribble buffer"))
(defun gnus-group-exit ()
"Quit reading news after updating .newsrc.eld and .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
+ (interactive nil gnus-group-mode)
(when
(or noninteractive ;For gnus-batch-kill
(not gnus-interactive-exit) ;Without confirmation
@@ -4466,7 +4477,7 @@ The hook `gnus-exit-gnus-hook' is called before actually
exiting."
(defun gnus-group-quit ()
"Quit reading news without updating .newsrc.eld or .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (or noninteractive ;For gnus-batch-kill
(zerop (buffer-size))
(not (gnus-server-opened gnus-select-method))
@@ -4491,7 +4502,7 @@ The hook `gnus-exit-gnus-hook' is called before actually
exiting."
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-message 7 "%s" (substitute-command-keys
"\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select
\\[gnus-group-next-unread-group]:Forward
\\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit
\\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
(defun gnus-group-browse-foreign-server (method)
@@ -4504,7 +4515,7 @@ and the second element is the address."
(list (let ((how (gnus-completing-read
"Which back end"
(mapcar #'car (append gnus-valid-select-methods
- gnus-server-alist))
+ gnus-server-alist))
t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a back end name or a virtual server name.
;; If the first, we also need an address.
@@ -4520,7 +4531,8 @@ and the second element is the address."
gnus-secondary-servers
(cdr gnus-select-method))))
;; We got a server name.
- how))))
+ how)))
+ gnus-group-mode)
(gnus-browse-foreign-server method))
(defun gnus-group-set-info (info &optional method-only-group part)
@@ -4678,7 +4690,7 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
@@ -4709,7 +4721,7 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
@@ -4731,7 +4743,7 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
@@ -4759,7 +4771,7 @@ This command may read the active file."
(defun gnus-group-list-plus (&optional _args)
"List groups plus the current selection."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((gnus-group-listed-groups (gnus-group-listed-groups))
(gnus-group-list-mode gnus-group-list-mode) ;; Save it.
func)
@@ -4775,7 +4787,7 @@ This command may read the active file."
(defun gnus-group-list-flush (&optional args)
"Flush groups from the current selection."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-group-list-option 'flush))
(gnus-group-list-plus args)))
@@ -4786,7 +4798,7 @@ with this command. If you've first limited to groups with
dormant articles with `A ?', you can then further limit with
`A / c', which will then limit to groups with cached articles, giving
you the groups that have both dormant articles and cached articles."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-group-list-option 'limit))
(gnus-group-list-plus args)))
@@ -4839,7 +4851,7 @@ operation is only meaningful for back ends using one file
per article
\(e.g. nnml).
Note: currently only implemented in nnml."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(unless group
(error "No group to compact"))
(unless (gnus-check-backend-function 'request-compact-group group)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 9811e8b..1b2743c 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -970,7 +970,7 @@ These will be used to retrieve the RSVP information from
ical events."
(defun gnus-icalendar-save-event ()
"Save the Calendar event in the text/calendar part under point."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
@@ -978,28 +978,28 @@ These will be used to retrieve the RSVP information from
ical events."
(defun gnus-icalendar-reply-accept ()
"Accept invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'accepted
gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'accepted)))
(defun gnus-icalendar-reply-tentative ()
"Send tentative response to invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'tentative
gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'tentative)))
(defun gnus-icalendar-reply-decline ()
"Decline invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'declined
gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'declined)))
(defun gnus-icalendar-event-export ()
"Export calendar event to `org-mode', or update existing agenda entry."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-sync-event-to-org gnus-icalendar-event))
;; refresh article buffer in case the reply had been sent before initial org
@@ -1009,14 +1009,14 @@ These will be used to retrieve the RSVP information
from ical events."
(defun gnus-icalendar-event-show ()
"Display `org-mode' agenda entry related to the calendar event."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-icalendar--show-org-event
(with-current-buffer gnus-article-buffer
gnus-icalendar-event)))
(defun gnus-icalendar-event-check-agenda ()
"Display `org-mode' agenda for days between event start and end dates."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-icalendar-show-org-agenda
(with-current-buffer gnus-article-buffer gnus-icalendar-event)))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 6492862..0105379 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -662,7 +662,7 @@ This is the string that Gnus uses to identify the group."
"Look up the current article in the group where it originated.
This command only makes sense for groups shows articles gathered
from other groups -- for instance, search results and the like."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-command-method
(gnus-find-method-for-group gnus-newsgroup-name)))
(or
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index fc8d9be..df076c1 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -53,7 +53,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
(gnus-summary-save-article arg)))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 45e665b..d7851f2 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -609,8 +609,6 @@ instead."
If ARG, use the group under the point to find a posting style.
If ARG is 1, prompt for a group name to find the posting style."
(interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -634,8 +632,6 @@ This function prepares a news even when using mail groups.
This is useful
for posting messages to mail groups without actually sending them over the
network. The corresponding back end must have a `request-post' method."
(interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -657,7 +653,7 @@ network. The corresponding back end must have a
`request-post' method."
If ARG, post to group under point. If ARG is 1, prompt for group name.
Depending on the selected group, the message might be either a mail or
a news."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
(if arg
@@ -676,9 +672,7 @@ a news."
Use the posting of the current group by default.
If ARG, don't do that. If ARG is 1, prompt for group name to find the
posting style."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
+ (interactive "P" gnus-summary-mode)
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -701,9 +695,7 @@ If ARG, don't do that. If ARG is 1, prompt for group name
to post to.
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
network. The corresponding back end must have a `request-post' method."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
+ (interactive "P" gnus-summary-mode)
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -730,7 +722,7 @@ network. The corresponding back end must have a
`request-post' method."
If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
Depending on the selected group, the message might be either a mail or
a news."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
(if arg
@@ -750,9 +742,9 @@ If prefix argument YANK is non-nil, the original article is
yanked
automatically.
YANK is a list of elements, where the car of each element is the
article number, and the cdr is the string to be yanked."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(when yank
(gnus-summary-goto-subject
(if (listp (car yank))
@@ -772,19 +764,19 @@ article number, and the cdr is the string to be yanked."
"Compose a followup to an article and include the original article.
The text in the region will be yanked. If the region isn't
active, the entire article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
(defun gnus-summary-followup-to-mail (&optional arg)
"Followup to the current mail message via news."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-followup arg t))
(defun gnus-summary-followup-to-mail-with-original (&optional arg)
"Followup to the current mail message via news."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
@@ -819,7 +811,7 @@ active, the entire article will be yanked."
Uses the process-prefix convention. If given the symbolic
prefix `a', cancel using the standard posting method; if not
post using the current select method."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-summary-mode)
(let ((message-post-method
(let ((gn gnus-newsgroup-name))
(lambda (_arg) (gnus-post-method (eq symp 'a) gn))))
@@ -849,7 +841,7 @@ post using the current select method."
"Compose an article that will supersede a previous article.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
@@ -1088,7 +1080,6 @@ If SILENT, don't prompt the user."
(defun gnus-extended-version ()
"Stringified Gnus version and Emacs version.
See the variable `gnus-user-agent'."
- (interactive)
(if (stringp gnus-user-agent)
gnus-user-agent
;; `gnus-user-agent' is a list:
@@ -1117,9 +1108,9 @@ If prefix argument YANK is non-nil, the original article
is yanked
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
;; Allow user to require confirmation before replying by mail to the
;; author of a news article (or mail message).
(when (or (not (or (gnus-news-group-p gnus-newsgroup-name)
@@ -1187,14 +1178,14 @@ If VERY-WIDE, make a very wide reply."
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply (gnus-summary-work-articles n) wide))
(defun gnus-summary-reply-to-list-with-original (n &optional wide)
"Start composing a reply mail to the current message.
The reply goes only to the mailing list.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((message-reply-to-function
(lambda nil
`((To . ,(gnus-mailing-list-followup-to))))))
@@ -1206,32 +1197,32 @@ If prefix argument YANK is non-nil, the original
article is yanked
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(let ((gnus-msg-force-broken-reply-to t))
(gnus-summary-reply yank wide very-wide)))
(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
"Like `gnus-summary-reply-with-original' except removing reply-to field.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-reply yank t))
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
The original article(s) will be yanked.
Uses the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply-with-original n t))
(defun gnus-summary-very-wide-reply (&optional yank)
@@ -1244,9 +1235,9 @@ messages as the To/Cc headers.
If prefix argument YANK is non-nil, the original article(s) will
be yanked automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-reply yank t (gnus-summary-work-articles yank)))
(defun gnus-summary-very-wide-reply-with-original (n)
@@ -1258,7 +1249,7 @@ The reply will include all From/Cc headers from the
original
messages as the To/Cc headers.
The original article(s) will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply
(gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
@@ -1274,7 +1265,7 @@ otherwise, use flipped `message-forward-as-mime'.
If POST, post instead of mail.
For the \"inline\" alternatives, also see the variable
`message-forward-ignored-headers'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if (cdr (gnus-summary-work-articles nil))
;; Process marks are given.
(gnus-uu-digest-mail-forward nil post)
@@ -1363,7 +1354,8 @@ the message before resending."
;; initial-contents.
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-summary-mode)
(let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
(message-sent-hook (copy-sequence message-sent-hook))
;; Honor posting-style for `name' and `address' in Resent-From header.
@@ -1416,7 +1408,7 @@ the message before resending."
A new buffer will be created to allow the user to modify body and
contents of the message, and then, everything will happen as when
composing a new message."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
@@ -1444,12 +1436,12 @@ composing a new message."
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
See `gnus-summary-mail-forward' for ARG."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mail-forward arg t))
(defun gnus-summary-mail-crosspost-complaint (n)
"Send a complaint about crossposting to the current article(s)."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(dolist (article (gnus-summary-work-articles n))
(set-buffer gnus-summary-buffer)
(gnus-summary-goto-subject article)
@@ -1517,9 +1509,9 @@ Already submitted bugs can be found in the Emacs bug
tracker:
(defun gnus-summary-yank-message (buffer n)
"Yank the current article into a composed message."
- (interactive
- (list (gnus-completing-read "Buffer" (message-buffers) t)
- current-prefix-arg))
+ (interactive (list (gnus-completing-read "Buffer" (message-buffers) t)
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-iterate n
(let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
@@ -1536,7 +1528,7 @@ contains some mail you have written which has been
bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
this is a reply."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article t)
(let (summary-buffer parent)
(if fetch
@@ -1579,7 +1571,6 @@ this is a reply."
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
- (interactive)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -1972,7 +1963,7 @@ created.
This command uses the process/prefix convention, so if you
process-mark several articles, they will all be attached."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((buffers (message-buffers))
destination)
;; Set up the destination mail composition buffer.
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 7927b88..fd4d3b8 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -244,7 +244,7 @@ replacement is added."
(gnus-picon-insert-glyph (pop spec) category))))))))))
(defun gnus-picon-transform-newsgroups (header)
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(gnus-article-goto-header header)
(mail-header-narrow-to-field)
@@ -283,7 +283,7 @@ replacement is added."
(defun gnus-treat-from-picon ()
"Display picons in the From header.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
@@ -294,7 +294,7 @@ If picons are already displayed, remove them."
(defun gnus-treat-mail-picon ()
"Display picons in the Cc and To headers.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
@@ -306,7 +306,7 @@ If picons are already displayed, remove them."
(defun gnus-treat-newsgroups-picon ()
"Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 147550d..9a22256 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -813,7 +813,7 @@ Consults `gnus-registry-ignored-groups' and
(defun gnus-registry-wash-for-keywords (&optional force)
"Get the keywords of the current article.
Overrides existing keywords with FORCE set non-nil."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
word words)
(if (or (not (gnus-registry-get-id-key id 'keyword))
@@ -1039,13 +1039,15 @@ Uses `gnus-registry-marks' to find what shortcuts to
install."
(defun gnus-registry-set-article-mark (&rest articles)
"Apply a mark to process-marked ARTICLES."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-article-mode gnus-summary-mode)
(gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
articles nil t))
(defun gnus-registry-remove-article-mark (&rest articles)
"Remove a mark from process-marked ARTICLES."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-article-mode gnus-summary-mode)
(gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
articles t t))
@@ -1069,7 +1071,8 @@ Uses `gnus-registry-marks' to find what shortcuts to
install."
"Get the Gnus registry marks for ARTICLES and show them if interactive.
Uses process/prefix conventions. For multiple articles,
only the last one's marks are returned."
- (interactive (gnus-summary-work-articles 1))
+ (interactive (gnus-summary-work-articles 1)
+ gnus-article-mode gnus-summary-mode)
(let* ((article (last articles))
(id (gnus-registry-fetch-message-id-fast article))
(marks (when id (gnus-registry-get-id-key id 'mark))))
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index e222d24..5b746a8 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -137,6 +137,8 @@ It accepts the same format specs that
`gnus-summary-line-format' does."
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
(interactive "P")
+ (declare (completion (lambda (s b)
+ (completion-minor-mode-active-p s b 'gnus-pick-mode))))
(if gnus-newsgroup-processable
(progn
(gnus-summary-limit-to-articles nil)
@@ -462,7 +464,7 @@ Two predefined functions are available:
(defun gnus-tree-read-summary-keys (&optional arg)
"Read a summary buffer key sequence and execute it."
- (interactive "P")
+ (interactive "P" gnus-tree-mode)
(unless gnus-tree-inhibit
(let ((buf (current-buffer))
(gnus-tree-inhibit t)
@@ -477,7 +479,7 @@ Two predefined functions are available:
(defun gnus-tree-show-summary ()
"Reconfigure windows to show summary buffer."
- (interactive)
+ (interactive nil gnus-tree-mode)
(if (not (gnus-buffer-live-p gnus-summary-buffer))
(error "There is no summary buffer for this tree buffer")
(gnus-configure-windows 'article)
@@ -485,7 +487,7 @@ Two predefined functions are available:
(defun gnus-tree-select-article (article)
"Select the article under point, if any."
- (interactive (list (gnus-tree-article-number)))
+ (interactive (list (gnus-tree-article-number)) gnus-tree-mode)
(let ((buf (current-buffer)))
(when article
(with-current-buffer gnus-summary-buffer
@@ -494,7 +496,7 @@ Two predefined functions are available:
(defun gnus-tree-pick-article (e)
"Select the article under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-tree-mode)
(mouse-set-point e)
(gnus-tree-select-article (gnus-tree-article-number)))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index ade0897..ce64dce 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -528,7 +528,8 @@ permanence, and the string to be used. The numerical
prefix will
be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
says to use the `all.SCORE' file for the command instead of the
current score file."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny")
+ gnus-article-mode gnus-summary-mode)
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(defun gnus-score-kill-help-buffer ()
@@ -544,7 +545,8 @@ permanence, and the string to be used. The numerical
prefix will
be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
says to use the `all.SCORE' file for the command instead of the
current score file."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny")
+ gnus-article-mode gnus-summary-mode)
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
@@ -931,15 +933,16 @@ TYPE is the score type.
SCORE is the score to add.
EXTRA is the possible non-standard header."
(interactive (list (gnus-completing-read "Header"
- (mapcar
+ (mapcar
#'car
(seq-filter
(lambda (x) (fboundp (nth 2 x)))
gnus-header-index))
- t)
+ t)
(read-string "Match: ")
(if (y-or-n-p "Use regexp match? ") 'r 's)
- (string-to-number (read-string "Score: "))))
+ (string-to-number (read-string "Score: ")))
+ gnus-article-mode gnus-summary-mode)
(save-excursion
(unless (and (stringp match) (> (length match) 0))
(error "No match"))
@@ -974,7 +977,8 @@ EXTRA is the possible non-standard header."
"Automatically mark articles with score below SCORE as read."
(interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Mark below: ")))))
+ (string-to-number (read-string "Mark below: "))))
+ gnus-article-mode gnus-summary-mode)
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'mark (list score))
(gnus-score-set 'touched '(t))
@@ -1008,14 +1012,15 @@ EXTRA is the possible non-standard header."
"Automatically expunge articles with score below SCORE."
(interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Set expunge below: ")))))
+ (string-to-number (read-string "Set expunge below: "))))
+ gnus-article-mode gnus-summary-mode)
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'expunge (list score))
(gnus-score-set 'touched '(t)))
(defun gnus-score-followup-article (&optional score)
"Add SCORE to all followups to the article in the current buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
@@ -1030,7 +1035,7 @@ EXTRA is the possible non-standard header."
(defun gnus-score-followup-thread (&optional score)
"Add SCORE to all later articles in the thread the current buffer is part
of."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
@@ -1064,13 +1069,13 @@ EXTRA is the possible non-standard header."
(defun gnus-summary-raise-score (n)
"Raise the score of the current article by N."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-set-score (+ (gnus-summary-article-score)
(or n gnus-score-interactive-default-score ))))
(defun gnus-summary-set-score (n)
"Set the score of the current article to N."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(save-excursion
(gnus-summary-show-thread)
(let ((buffer-read-only nil))
@@ -1089,7 +1094,7 @@ EXTRA is the possible non-standard header."
(defun gnus-summary-current-score (arg)
"Return the score of the current article.
With prefix ARG, return the total score of the current (sub)thread."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(message "%s" (if arg
(gnus-thread-total-score
(gnus-id-to-thread
@@ -1099,14 +1104,16 @@ EXTRA is the possible non-standard header."
(defun gnus-score-change-score-file (file)
"Change current score alist."
(interactive
- (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
+ (list (read-file-name "Change to score file: " gnus-kill-files-directory))
+ gnus-article-mode gnus-summary-mode)
(gnus-score-load-file file)
(gnus-set-mode-line 'summary))
(defvar gnus-score-edit-exit-function)
(defun gnus-score-edit-current-scores (file)
"Edit the current score alist."
- (interactive (list gnus-current-score-file))
+ (interactive (list gnus-current-score-file)
+ gnus-article-mode gnus-summary-mode)
(if (not gnus-current-score-file)
(error "No current score file")
(let ((winconf (current-window-configuration)))
@@ -2496,7 +2503,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(defun gnus-score-find-trace ()
"Find all score rules that applies to the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((old-scored gnus-newsgroup-scored))
(let ((gnus-newsgroup-headers
(list (gnus-summary-article-header)))
@@ -2611,7 +2618,7 @@ the score file and its full name, including the
directory.")
(defun gnus-summary-rescore ()
"Redo the entire scoring process in the current summary."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-score-save)
(setq gnus-score-cache nil)
(setq gnus-newsgroup-scored nil)
@@ -2642,7 +2649,7 @@ the score file and its full name, including the
directory.")
(defun gnus-summary-raise-same-subject-and-select (score)
"Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(let ((subject (gnus-summary-article-subject)))
(gnus-summary-raise-score score)
(while (gnus-summary-find-subject subject)
@@ -2651,7 +2658,7 @@ the score file and its full name, including the
directory.")
(defun gnus-summary-raise-same-subject (score)
"Raise articles which has the same subject with SCORE."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(let ((subject (gnus-summary-article-subject)))
(gnus-summary-raise-score score)
(while (gnus-summary-find-subject subject)
@@ -2664,7 +2671,7 @@ the score file and its full name, including the
directory.")
(defun gnus-summary-raise-thread (&optional score)
"Raise the score of the articles in the current thread with SCORE."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(let (e)
(save-excursion
@@ -2683,17 +2690,17 @@ the score file and its full name, including the
directory.")
(defun gnus-summary-lower-same-subject-and-select (score)
"Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-same-subject-and-select (- score)))
(defun gnus-summary-lower-same-subject (score)
"Raise articles which has the same subject with SCORE."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-same-subject (- score)))
(defun gnus-summary-lower-thread (&optional score)
"Lower score of articles in the current thread with SCORE."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-thread (- (gnus-score-delta-default score))))
;;; Finding score files.
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 5dcd079..eeedf7f 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -113,7 +113,7 @@ Return nil if no rule could be guessed."
;;;###autoload
(defun gnus-sieve-article-add-rule ()
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-summary-select-article nil 'force)
(with-current-buffer gnus-original-article-buffer
(let ((rule (gnus-sieve-guess-rule-for-article))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index a305e34..f66f842 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -409,7 +409,7 @@ The following commands are available:
(defun gnus-server-kill-server (server)
"Kill the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless (gnus-server-goto-server server)
(if server (error "No such server: %s" server)
(error "No server on the current line")))
@@ -438,7 +438,7 @@ The following commands are available:
(defun gnus-server-yank-server ()
"Yank the previously killed server."
- (interactive)
+ (interactive nil gnus-server-mode)
(unless gnus-server-killed-servers
(error "No killed servers to be yanked"))
(let ((alist gnus-server-alist)
@@ -460,14 +460,14 @@ The following commands are available:
(defun gnus-server-exit ()
"Return to the group buffer."
- (interactive)
+ (interactive nil gnus-server-mode)
(gnus-run-hooks 'gnus-server-exit-hook)
(gnus-kill-buffer (current-buffer))
(gnus-configure-windows 'group t))
(defun gnus-server-list-servers ()
"List all available servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((cur (gnus-server-server-name)))
(gnus-server-prepare)
(if cur (gnus-server-goto-server cur)
@@ -489,7 +489,7 @@ The following commands are available:
(defun gnus-server-open-server (server)
"Force an open of SERVER."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -501,13 +501,13 @@ The following commands are available:
(defun gnus-server-open-all-servers ()
"Open all servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-inserted-opened-servers)
(gnus-server-open-server (car server))))
(defun gnus-server-close-server (server)
"Close SERVER."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -519,7 +519,7 @@ The following commands are available:
(defun gnus-server-offline-server (server)
"Set SERVER to offline."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -531,7 +531,7 @@ The following commands are available:
(defun gnus-server-close-all-servers ()
"Close all servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-inserted-opened-servers)
(gnus-server-close-server (car server)))
(dolist (server gnus-server-alist)
@@ -539,7 +539,7 @@ The following commands are available:
(defun gnus-server-deny-server (server)
"Make sure SERVER will never be attempted opened."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -550,7 +550,7 @@ The following commands are available:
(defun gnus-server-remove-denials ()
"Make all denied servers into closed servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-opened-servers)
(when (eq (nth 1 server) 'denied)
(setcar (nthcdr 1 server) 'closed)))
@@ -558,11 +558,11 @@ The following commands are available:
(defun gnus-server-copy-server (from to)
"Copy a server definition to a new name."
- (interactive
- (list
- (or (gnus-server-server-name)
- (error "No server on the current line"))
- (read-string "Copy to: ")))
+ (interactive (list
+ (or (gnus-server-server-name)
+ (error "No server on the current line"))
+ (read-string "Copy to: "))
+ gnus-server-mode)
(unless from
(error "No server on current line"))
(unless (and to (not (string= to "")))
@@ -583,7 +583,8 @@ The following commands are available:
(list (intern (gnus-completing-read "Server method"
(mapcar #'car gnus-valid-select-methods)
t))
- (read-string "Server name: ")))
+ (read-string "Server name: "))
+ gnus-server-mode)
(when (assq where gnus-server-alist)
(error "Server with that name already defined"))
(push (list where how where) gnus-server-killed-servers)
@@ -593,7 +594,8 @@ The following commands are available:
"Jump to a server line."
(interactive
(list (gnus-completing-read "Goto server"
- (mapcar #'car gnus-server-alist) t)))
+ (mapcar #'car gnus-server-alist) t))
+ gnus-server-mode)
(let ((to (text-property-any (point-min) (point-max)
'gnus-server (intern server))))
(when to
@@ -602,7 +604,7 @@ The following commands are available:
(defun gnus-server-edit-server (server)
"Edit the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless server
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
@@ -620,7 +622,7 @@ The following commands are available:
(defun gnus-server-show-server (server)
"Show the definition of the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless server
(error "No server on current line"))
(let ((info (gnus-server-to-method server)))
@@ -632,7 +634,7 @@ The following commands are available:
(defun gnus-server-scan-server (server)
"Request a scan from the current server."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(if (not (gnus-get-function method 'request-scan))
(error "Server %s can't scan" (car method))
@@ -897,7 +899,7 @@ buffer.
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
If NUMBER, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-browse-mode)
(let* ((full-name (gnus-browse-group-name))
(group (if (gnus-native-method-p
(gnus-find-method-for-group full-name))
@@ -916,26 +918,26 @@ If NUMBER, fetch this number of articles."
(defun gnus-browse-select-group (&optional number)
"Select the current group.
If NUMBER, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-browse-mode)
(gnus-browse-read-group 'no number))
(defun gnus-browse-next-group (n)
"Go to the next group."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(prog1
(forward-line n)
(gnus-group-position-point)))
(defun gnus-browse-prev-group (n)
"Go to the next group."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(gnus-browse-next-group (- n)))
(defun gnus-browse-unsubscribe-current-group (arg)
"(Un)subscribe to the next ARG groups.
The variable `gnus-browse-subscribe-newsgroup-method' determines
how new groups will be entered into the group buffer."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(when (eobp)
(error "No group at current line"))
(let ((ward (if (< arg 0) -1 1))
@@ -961,7 +963,7 @@ how new groups will be entered into the group buffer."
(defun gnus-browse-describe-group (group)
"Describe the current group."
- (interactive (list (gnus-browse-group-name)))
+ (interactive (list (gnus-browse-group-name)) gnus-browse-mode)
(gnus-group-describe-group nil group))
(defun gnus-browse-delete-group (group force)
@@ -970,8 +972,8 @@ If FORCE (the prefix) is non-nil, all the articles in the
group will
be deleted. This is \"deleted\" as in \"removed forever from the face
of the Earth\". There is no undo. The user will be prompted before
doing the deletion."
- (interactive (list (gnus-browse-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-browse-group-name) current-prefix-arg)
+ gnus-browse-mode)
(gnus-group-delete-group group force))
(defun gnus-browse-unsubscribe-group ()
@@ -1020,7 +1022,7 @@ doing the deletion."
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
- (interactive)
+ (interactive nil gnus-browse-mode)
(when (derived-mode-p 'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
@@ -1032,7 +1034,7 @@ doing the deletion."
(defun gnus-browse-describe-briefly ()
"Give a one line description of the group mode commands."
- (interactive)
+ (interactive nil gnus-browse-mode)
(gnus-message 6 "%s"
(substitute-command-keys
"\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward
\\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit
\\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
@@ -1089,7 +1091,7 @@ Requesting compaction of %s... (this may take a long
time)"
(defun gnus-server-toggle-cloud-server ()
"Toggle whether the server under point is replicated in the Emacs Cloud."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((server (gnus-server-server-name)))
(unless server
(error "No server on the current line"))
@@ -1110,7 +1112,7 @@ Requesting compaction of %s... (this may take a long
time)"
(defun gnus-server-set-cloud-method-server ()
"Set the server under point to host the Emacs Cloud."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((server (gnus-server-server-name)))
(unless server
(error "No server on the current line"))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 1554635..a3112bd 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1070,7 +1070,7 @@ With 1 C-u, use the `ask-server' method to query the
server for new
groups.
With 2 C-u's, use most complete method possible to query the server
for new groups, and subscribe the new groups as zombies."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let* ((gnus-subscribe-newsgroup-method
gnus-subscribe-newsgroup-method)
(check (cond
@@ -1405,7 +1405,7 @@ newsgroup."
(defun gnus-check-duplicate-killed-groups ()
"Remove duplicates from the list of killed groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((killed gnus-killed-list))
(while killed
(gnus-message 9 "%d" (length killed))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 456e7b0..4065cf0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -73,18 +73,10 @@
(eval-when-compile
(require 'subr-x))
-(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil
+ '(gnus-summary-mode))
(autoload 'gnus-cache-write-active "gnus-cache")
-(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
-(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
(autoload 'gnus-pick-line-number "gnus-salt" nil t)
-(autoload 'mm-uu-dissect "mm-uu")
-(autoload 'gnus-article-outlook-deuglify-article "deuglify"
- "Deuglify broken Outlook (Express) articles and redisplay."
- t)
-(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
-(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
-(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
(autoload 'nnselect-article-rsv "nnselect" nil nil)
(autoload 'nnselect-article-group "nnselect" nil nil)
(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
@@ -2525,6 +2517,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
(let ((gnus-summary-show-article-charset-alist
`((1 . ,cs))))
(gnus-summary-show-article 1))))
+ (put command 'completion-predicate 'ignore)
`[,(symbol-name cs) ,command t]))
(sort (coding-system-list) #'string<)))))
("Washing"
@@ -3149,6 +3142,7 @@ buffer; read the Info manual for more information
(`\\[gnus-info-find-node]').
The following commands are available:
\\{gnus-summary-mode-map}"
+ :interactive nil
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-make-local-variables))
(gnus-summary-make-local-variables)
@@ -3479,7 +3473,7 @@ marks of articles."
;; Various summary mode internalish functions.
(defun gnus-mouse-pick-article (e)
- (interactive "e")
+ (interactive "e" gnus-summary-mode)
(mouse-set-point e)
(gnus-summary-next-page nil t))
@@ -4219,7 +4213,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(defun gnus-summary-prepare ()
"Generate the summary buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(setq gnus-newsgroup-data nil
@@ -4268,7 +4262,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(defun gnus-summary-simplify-subject-query ()
"Query where the respool algorithm would put this article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(message "%s" (gnus-general-simplify-subject
(gnus-summary-article-subject))))
@@ -6671,19 +6665,19 @@ executed with point over the summary line of the
articles."
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
- (interactive)
+ (interactive nil gnus-summary-mode)
(push (copy-sequence gnus-newsgroup-processable)
gnus-newsgroup-process-stack))
(defun gnus-summary-kill-process-mark ()
"Push the current set of process marked articles on the stack and unmark."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-save-process-mark)
(gnus-summary-unmark-all-processable))
(defun gnus-summary-yank-process-mark ()
"Pop the last process mark state off the stack and restore it."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-process-stack
(error "Empty mark stack"))
(gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
@@ -6818,7 +6812,7 @@ articles with that subject. If BACKWARD, search backward
instead."
(defun gnus-recenter (&optional n)
"Center point in window and redisplay frame.
Also do horizontal recentering."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (and gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
@@ -6852,7 +6846,7 @@ If `gnus-auto-center-summary' is nil, or the article
buffer isn't
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
- (interactive)
+ (interactive nil gnus-summary-mode)
;; The user has to want it.
(when gnus-auto-center-summary
(let* ((top (cond ((< (window-height) 4) 0)
@@ -7029,7 +7023,7 @@ displayed, no centering will be performed."
"Reconfigure windows to show the article buffer.
If `gnus-widen-article-window' is set, show only the article
buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
(or (get-buffer-window gnus-article-buffer)
@@ -7052,7 +7046,7 @@ buffer."
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((articles (gnus-summary-work-articles arg))
func article)
(if (eq
@@ -7073,7 +7067,7 @@ buffer."
(gnus-summary-position-point))
(define-obsolete-function-alias
- 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1")
+ 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1")
(defun gnus-summary-find-for-reselect ()
"Return the number of an article to stay on across a reselect.
@@ -7095,7 +7089,7 @@ insertion from another group. If there's no such then
return a dummy 0."
(defun gnus-summary-reselect-current-group (&optional all rescan)
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-find-for-reselect))
@@ -7113,7 +7107,7 @@ The prefix argument ALL means to select all articles."
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((config gnus-current-window-configuration))
(gnus-summary-reselect-current-group all t)
(gnus-configure-windows config)
@@ -7168,7 +7162,7 @@ The prefix argument ALL means to select all articles."
(defun gnus-summary-make-group-from-search ()
"Make a persistent group from the current ephemeral search group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(if (not (gnus-nnselect-group-p gnus-newsgroup-name))
(gnus-message 3 "%s is not a search group" gnus-newsgroup-name)
(let ((name (gnus-read-group "Group name: ")))
@@ -7185,7 +7179,7 @@ The prefix argument ALL means to select all articles."
"Save the current number of read/marked articles in the dribble buffer.
The dribble buffer will then be saved.
If FORCE (the prefix), also save the .newsrc file(s)."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-update-info t)
(if force
(gnus-save-newsrc-file)
@@ -7197,7 +7191,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-set-global-variables)
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
@@ -7303,7 +7297,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((group gnus-newsgroup-name)
(gnus-group-is-exiting-p t)
(gnus-group-is-exiting-without-update-p t)
@@ -7457,7 +7451,7 @@ The state which existed when entering the ephemeral is
reset."
(defun gnus-summary-wake-up-the-dead (&rest _)
"Wake up the dead summary buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-dead-summary-mode -1)
(let ((name (buffer-name)))
(when (string-match "Dead " name)
@@ -7470,12 +7464,12 @@ The state which existed when entering the ephemeral is
reset."
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-group-describe-group force gnus-newsgroup-name))
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-message 6 "%s" (substitute-command-keys
"\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select
\\[gnus-summary-next-unread-article]:Forward
\\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit
\\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This
help")))
;; Walking around group mode buffer from summary mode.
@@ -7485,7 +7479,7 @@ The state which existed when entering the ephemeral is
reset."
If prefix argument NO-ARTICLE is non-nil, no article is selected
initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Stop pre-fetching.
(gnus-async-halt-prefetch)
(let ((current-group gnus-newsgroup-name)
@@ -7531,7 +7525,7 @@ previous group instead."
(defun gnus-summary-prev-group (&optional no-article)
"Exit current newsgroup and then select previous unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-next-group no-article nil t))
;; Walking around summary lines.
@@ -7542,7 +7536,7 @@ If UNREAD is non-nil, the article should be unread.
If UNDOWNLOADED is non-nil, the article should be undownloaded.
If UNSEEN is non-nil, the article should be unseen as well as unread.
Returns the article selected or nil if there are no matching articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(cond
;; Empty summary.
((null gnus-newsgroup-data)
@@ -7594,7 +7588,7 @@ If N is negative, go to the previous N'th subject line.
If UNREAD is non-nil, only unread articles are selected.
The difference between N and the actual number of steps taken is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -7613,18 +7607,18 @@ returned."
(defun gnus-summary-next-unread-subject (n)
"Go to next N'th unread summary line."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject n t))
(defun gnus-summary-prev-subject (n &optional unread)
"Go to previous N'th summary line.
If optional argument UNREAD is non-nil, only unread article is selected."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject (- n) unread))
(defun gnus-summary-prev-unread-subject (n)
"Go to previous N'th unread summary line."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject (- n) t))
(defun gnus-summary-goto-subjects (articles)
@@ -7638,7 +7632,7 @@ If optional argument UNREAD is non-nil, only unread
article is selected."
(defun gnus-summary-goto-subject (article &optional force silent)
"Go to the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
- (interactive "nArticle number: ")
+ (interactive "nArticle number: " gnus-summary-mode)
(unless (numberp article)
(error "Article %s is not a number" article))
(let ((b (point))
@@ -7668,7 +7662,7 @@ If FORCE, also allow jumping to articles not currently
shown."
(defun gnus-summary-expand-window (&optional arg)
"Make the summary buffer take up the entire Emacs frame.
Given a prefix, will force an `article' buffer configuration."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if arg
(gnus-configure-windows 'article 'force)
(gnus-configure-windows 'summary 'force)))
@@ -7751,7 +7745,7 @@ be displayed."
(defun gnus-summary-force-verify-and-decrypt ()
"Display buttons for signed/encrypted parts and verify/decrypt them."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(gnus-article-emulate-mime t)
@@ -7765,7 +7759,7 @@ be displayed."
If UNREAD, only unread articles are selected.
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Make sure we are in the summary buffer.
(unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
@@ -7877,7 +7871,7 @@ If BACKWARD, the previous article is selected instead of
the next."
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-last-article-p (gnus-summary-article-number)))
@@ -7887,12 +7881,12 @@ If BACKWARD, the previous article is selected instead
of the next."
(defun gnus-summary-prev-article (&optional unread subject)
"Select the article before the current one.
If UNREAD is non-nil, only unread articles are selected."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-next-article unread subject t))
(defun gnus-summary-prev-unread-article ()
"Select unread article before current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-first-article-p (gnus-summary-article-number)))
@@ -7913,7 +7907,7 @@ article.
If STOP is non-nil, just stop when reaching the end of the message.
Also see the variable `gnus-article-skip-boring'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
(article-window (get-buffer-window gnus-article-buffer t))
@@ -7958,7 +7952,7 @@ Also see the variable `gnus-article-skip-boring'."
Argument LINES specifies lines to be scrolled down.
If MOVE, move to the previous unread article if point is at
the beginning of the buffer."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(article-window (get-buffer-window gnus-article-buffer t))
endp)
@@ -7988,14 +7982,14 @@ the beginning of the buffer."
"Show previous page of selected article.
Argument LINES specifies lines to be scrolled down.
If at the beginning of the article, go to the next article."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-prev-page lines t))
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative).
If no article is selected, then the current article will be selected first."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
@@ -8012,33 +8006,33 @@ If no article is selected, then the current article
will be selected first."
"Scroll down (or up) one line current article.
Argument LINES specifies lines to be scrolled down (or up if negative).
If no article is selected, then the current article will be selected first."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-scroll-up (- lines)))
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article nil (gnus-summary-article-subject)))
(defun gnus-summary-prev-same-subject ()
"Select previous article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article nil (gnus-summary-article-subject)))
(defun gnus-summary-next-unread-same-subject ()
"Select next unread article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article t (gnus-summary-article-subject)))
(defun gnus-summary-prev-unread-same-subject ()
"Select previous unread article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article t (gnus-summary-article-subject)))
(defun gnus-summary-first-unread-article ()
"Select the first unread article.
Return nil if there are no unread articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
@@ -8049,7 +8043,7 @@ Return nil if there are no unread articles."
(defun gnus-summary-first-unread-subject ()
"Place the point on the subject line of the first unread article.
Return nil if there are no unread articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
@@ -8058,7 +8052,7 @@ Return nil if there are no unread articles."
(defun gnus-summary-next-unseen-article (&optional backward)
"Select the next unseen article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((article (gnus-summary-article-number))
(articles (gnus-data-find-list article (gnus-data-list backward))))
(when (or (not gnus-summary-check-current)
@@ -8079,13 +8073,13 @@ Return nil if there are no unread articles."
(defun gnus-summary-prev-unseen-article ()
"Select the previous unseen article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-unseen-article t))
(defun gnus-summary-first-unseen-subject ()
"Place the point on the subject line of the first unseen article.
Return nil if there are no unseen articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
@@ -8096,7 +8090,7 @@ Return nil if there are no unseen articles."
"Place the point on the subject line of the first unseen and unread article.
If all article have been seen, on the subject line of the first unread
article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(unless (when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
@@ -8109,7 +8103,7 @@ article."
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject)
(gnus-summary-show-thread)
@@ -8121,7 +8115,7 @@ Return nil if there are no articles."
"Select the unread article with the highest score.
If given a prefix argument, select the next unread article that has a
score higher than the default score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((article (if arg
(gnus-summary-better-unread-subject)
(gnus-summary-best-unread-subject))))
@@ -8131,7 +8125,7 @@ score higher than the default score."
(defun gnus-summary-best-unread-subject ()
"Select the unread subject with the highest score."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((best -1000000)
(data gnus-newsgroup-data)
article score)
@@ -8150,7 +8144,7 @@ score higher than the default score."
(defun gnus-summary-better-unread-subject ()
"Select the first unread subject that has a score over the default score."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((data gnus-newsgroup-data)
article)
(while (and (setq article (gnus-data-number (car data)))
@@ -8176,11 +8170,10 @@ If FORCE, go to the article even if it isn't displayed.
If FORCE
is a number, it is the line the article is to be displayed on."
(interactive
(list
- (gnus-completing-read
- "Article number or Message-ID"
- (mapcar #'int-to-string gnus-newsgroup-limit))
- current-prefix-arg
- t))
+ (gnus-completing-read "Article number or Message-ID"
+ (mapcar #'int-to-string gnus-newsgroup-limit))
+ current-prefix-arg t)
+ gnus-summary-mode)
(prog1
(if (and (stringp article)
(string-match "@\\|%40" article))
@@ -8194,7 +8187,7 @@ is a number, it is the line the article is to be
displayed on."
(defun gnus-summary-goto-last-article ()
"Go to the previously read article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when gnus-last-article
(gnus-summary-goto-article gnus-last-article nil t))
@@ -8203,7 +8196,7 @@ is a number, it is the line the article is to be
displayed on."
(defun gnus-summary-pop-article (number)
"Pop one article off the history and go to the previous.
NUMBER articles will be popped off."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let (to)
(setq gnus-newsgroup-history
(cdr (setq to (nthcdr number gnus-newsgroup-history))))
@@ -8217,7 +8210,7 @@ NUMBER articles will be popped off."
(defun gnus-summary-limit-to-articles (n)
"Limit the summary buffer to the next N articles.
If not given a prefix, use the process marked articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(let ((articles (gnus-summary-work-articles n)))
(setq gnus-newsgroup-processable nil)
@@ -8227,7 +8220,7 @@ If not given a prefix, use the process marked articles
instead."
(defun gnus-summary-pop-limit (&optional total)
"Restore the previous limit.
If given a prefix, remove all limits."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when total
(setq gnus-newsgroup-limits
(list (mapcar #'mail-header-number gnus-newsgroup-headers))))
@@ -8241,10 +8234,11 @@ If given a prefix, remove all limits."
"Limit the summary buffer to articles that have subjects that match a regexp.
If NOT-MATCHING, excluding articles that have subjects that match a regexp."
(interactive
- (list (read-string (if current-prefix-arg
- "Exclude subject (regexp): "
- "Limit to subject (regexp): "))
- nil current-prefix-arg))
+ (list
+ (read-string
+ (if current-prefix-arg "Exclude subject (regexp): " "Limit to subject
(regexp): "))
+ nil current-prefix-arg)
+ gnus-summary-mode)
(unless header
(setq header "subject"))
(when (not (equal "" subject))
@@ -8261,18 +8255,25 @@ If NOT-MATCHING, excluding articles that have subjects
that match a regexp."
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
(interactive
- (list (let* ((header (gnus-summary-article-header))
- (default (and header (car (mail-header-parse-address
- (mail-header-from header))))))
- (read-string (concat (if current-prefix-arg
- "Exclude author (regexp"
- "Limit to author (regexp")
- (if default
- (concat ", default \"" default "\"): ")
- "): "))
- nil nil
- default))
- current-prefix-arg))
+ (list
+ (let*
+ ((header
+ (gnus-summary-article-header))
+ (default
+ (and header
+ (car
+ (mail-header-parse-address
+ (mail-header-from header))))))
+ (read-string
+ (concat
+ (if current-prefix-arg
+ "Exclude author (regexp" "Limit to author (regexp")
+ (if default
+ (concat ", default \"" default "\"): ")
+ "): "))
+ nil nil default))
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-limit-to-subject from "from" not-matching))
(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
@@ -8284,9 +8285,12 @@ To and Cc headers are checked. You need to include them
in
`nnmail-extra-headers'."
;; Unlike `rmail-summary-by-recipients', doesn't include From.
(interactive
- (list (read-string (format "%s recipient (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format "%s recipient (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg)
+ gnus-summary-mode)
(when (not (equal "" recipient))
(prog1 (let* ((to
(if (memq 'To nnmail-extra-headers)
@@ -8326,9 +8330,12 @@ If NOT-MATCHING, exclude ADDRESS.
To, Cc and From headers are checked. You need to include `To' and `Cc'
in `nnmail-extra-headers'."
(interactive
- (list (read-string (format "%s address (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format "%s address (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg)
+ gnus-summary-mode)
(when (not (equal "" address))
(prog1 (let* ((to
(if (memq 'To nnmail-extra-headers)
@@ -8415,7 +8422,8 @@ articles that are younger than AGE days."
(setq days (* days -1))))
(message "Please enter a number.")
(sleep-for 1)))
- (list days younger)))
+ (list days younger))
+ gnus-summary-mode)
(prog1
(let ((data gnus-newsgroup-data)
(cutoff (days-to-time age))
@@ -8439,17 +8447,18 @@ articles that are younger than AGE days."
(let ((header
(intern
(gnus-completing-read
- (if current-prefix-arg
- "Exclude extra header"
- "Limit extra header")
+ (if current-prefix-arg "Exclude extra header" "Limit extra header")
(mapcar #'symbol-name gnus-extra-headers)
t nil nil
- (symbol-name (car gnus-extra-headers))))))
+ (symbol-name
+ (car gnus-extra-headers))))))
(list header
- (read-string (format "%s header %s (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")
- header))
- current-prefix-arg)))
+ (read-string
+ (format "%s header %s (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")
+ header))
+ current-prefix-arg))
+ gnus-summary-mode)
(when (not (equal "" regexp))
(prog1
(let ((articles (gnus-summary-find-matching
@@ -8462,7 +8471,7 @@ articles that are younger than AGE days."
(defun gnus-summary-limit-to-display-predicate ()
"Limit the summary buffer to the predicated in the `display' group
parameter."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-display
(error "There is no `display' group parameter"))
(let (articles)
@@ -8475,7 +8484,7 @@ articles that are younger than AGE days."
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
If ALL is non-nil, limit strictly to unread articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if all
(gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
(gnus-summary-limit-to-marks
@@ -8491,7 +8500,7 @@ If ALL is non-nil, limit strictly to unread articles."
(defun gnus-summary-limit-to-headers (match &optional reverse)
"Limit the summary buffer to articles that have headers that match MATCH.
If REVERSE (the prefix), limit to articles that don't match."
- (interactive "sMatch headers (regexp): \nP")
+ (interactive "sMatch headers (regexp): \nP" gnus-summary-mode)
(gnus-summary-limit-to-bodies match reverse t))
(declare-function article-goto-body "gnus-art" ())
@@ -8499,7 +8508,7 @@ If REVERSE (the prefix), limit to articles that don't
match."
(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
"Limit the summary buffer to articles that have bodies that match MATCH.
If REVERSE (the prefix), limit to articles that don't match."
- (interactive "sMatch body (regexp): \nP")
+ (interactive "sMatch body (regexp): \nP" gnus-summary-mode)
(let ((articles nil)
(gnus-select-article-hook nil) ;Disable hook.
(gnus-article-prepare-hook nil)
@@ -8532,7 +8541,7 @@ If REVERSE (the prefix), limit to articles that don't
match."
(defun gnus-summary-limit-to-singletons (&optional threadsp)
"Limit the summary buffer to articles that aren't part on any thread.
If THREADSP (the prefix), limit to articles that are in threads."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((articles nil)
thread-articles
threads)
@@ -8556,7 +8565,7 @@ If THREADSP (the prefix), limit to articles that are in
threads."
(defun gnus-summary-limit-to-replied (&optional unreplied)
"Limit the summary buffer to replied articles.
If UNREPLIED (the prefix), limit to unreplied articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if unreplied
(gnus-summary-limit
(gnus-set-difference gnus-newsgroup-articles
@@ -8569,7 +8578,7 @@ If UNREPLIED (the prefix), limit to unreplied articles."
If REVERSE, limit the summary buffer to articles that are marked
with MARKS. MARKS can either be a string of marks or a list of marks.
Returns how many articles were removed."
- (interactive "sMarks: ")
+ (interactive "sMarks: " gnus-summary-mode)
(gnus-summary-limit-to-marks marks t))
(defun gnus-summary-limit-to-marks (marks &optional reverse)
@@ -8578,7 +8587,7 @@ If REVERSE (the prefix), limit the summary buffer to
articles that are
not marked with MARKS. MARKS can either be a string of marks or a
list of marks.
Returns how many articles were removed."
- (interactive "sMarks: \nP")
+ (interactive "sMarks: \nP" gnus-summary-mode)
(prog1
(let ((data gnus-newsgroup-data)
(marks (if (listp marks) marks
@@ -8597,10 +8606,13 @@ Returns how many articles were removed."
With a prefix argument, limit to articles with score at or below
SCORE."
- (interactive (list (string-to-number
- (read-string
- (format "Limit to articles with score of at %s: "
- (if current-prefix-arg "most" "least"))))))
+ (interactive
+ (list
+ (string-to-number
+ (read-string
+ (format "Limit to articles with score of at %s: "
+ (if current-prefix-arg "most" "least")))))
+ gnus-summary-mode)
(let ((data gnus-newsgroup-data)
(compare (if (or below current-prefix-arg) #'<= #'>=))
articles)
@@ -8616,7 +8628,7 @@ SCORE."
(defun gnus-summary-limit-to-unseen ()
"Limit to unseen articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(gnus-summary-limit gnus-newsgroup-unseen)
(gnus-summary-position-point)))
@@ -8626,8 +8638,12 @@ SCORE."
When called interactively, ID is the Message-ID of the current
article. If thread-only is non-nil limit the summary buffer to
these articles."
- (interactive (list (mail-header-id (gnus-summary-article-header))
- current-prefix-arg))
+ (interactive
+ (list
+ (mail-header-id
+ (gnus-summary-article-header))
+ current-prefix-arg)
+ gnus-summary-mode)
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id))))
;;we REALLY want the whole thread---this prevents cut-threads
@@ -8653,8 +8669,11 @@ these articles."
(defun gnus-summary-limit-include-matching-articles (header regexp)
"Display all the hidden articles that have HEADERs that match REGEXP."
- (interactive (list (read-string "Match on header: ")
- (read-string "Regexp: ")))
+ (interactive
+ (list
+ (read-string "Match on header: ")
+ (read-string "Regexp: "))
+ gnus-summary-mode)
(let ((articles (gnus-find-matching-articles header regexp)))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
@@ -8662,7 +8681,7 @@ these articles."
(defun gnus-summary-insert-dormant-articles ()
"Insert all the dormant articles for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-dormant)
(gnus-message 3 "No dormant articles for this group")
@@ -8670,7 +8689,7 @@ these articles."
(defun gnus-summary-insert-ticked-articles ()
"Insert ticked articles for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-marked)
(gnus-message 3 "No ticked articles for this group")
@@ -8680,7 +8699,7 @@ these articles."
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
fetched for this group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-dormant
(error "There are no dormant articles in this group"))
(prog1
@@ -8703,14 +8722,14 @@ fetched for this group."
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
(gnus-summary-position-point)))
(defun gnus-summary-limit-exclude-childless-dormant ()
"Hide all dormant articles that have no children."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((data (gnus-data-list t))
articles d children)
;; Find all articles that are either not dormant or have
@@ -8735,7 +8754,7 @@ fetched for this group."
(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
"Mark all unread excluded articles as read.
If ALL, mark even excluded ticked and dormants as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<))
(let ((articles (gnus-sorted-ndifference
(sort
@@ -8974,7 +8993,7 @@ fetch-old-headers verbiage, and so on."
"Refer parent article N times.
If N is negative, go to ancestor -N instead.
The difference between N and the number of articles fetched is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((skip 1)
error header ref)
(when (not (natnump n))
@@ -9016,7 +9035,7 @@ The difference between N and the number of articles
fetched is returned."
(defun gnus-summary-refer-references ()
"Fetch all articles mentioned in the References header.
Return the number of articles fetched."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((ref (mail-header-references (gnus-summary-article-header)))
(current (gnus-summary-article-number))
(n 0))
@@ -9059,7 +9078,7 @@ has the reverse meaning. If no backend-specific
`request-thread'
function is available fetch LIMIT (the numerical prefix) old
headers. If LIMIT is non-numeric or nil fetch the number
specified by the `gnus-refer-thread-limit' variable."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((header (gnus-summary-article-header))
(id (mail-header-id header))
(gnus-inhibit-demon t)
@@ -9114,7 +9133,7 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-open-group-with-article (message-id)
"Open a group containing the article with the given MESSAGE-ID."
- (interactive "sMessage-ID: ")
+ (interactive "sMessage-ID: " gnus-summary-mode)
(require 'nndoc)
(with-temp-buffer
;; Prepare a dummy article
@@ -9149,7 +9168,7 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+ (interactive "sMessage-ID: " gnus-summary-mode)
(when (and (stringp message-id)
(not (zerop (length message-id))))
(setq message-id (replace-regexp-in-string " " "" message-id))
@@ -9222,12 +9241,12 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-group-edit-group gnus-newsgroup-name 'params))
(defun gnus-summary-customize-parameters ()
"Customize the group parameters of the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-group-customize gnus-newsgroup-name))
(defun gnus-summary-enter-digest-group (&optional force)
@@ -9237,7 +9256,7 @@ what the document format is.
To control what happens when you exit the group, see the
`gnus-auto-select-on-ephemeral-exit' variable."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((conf gnus-current-window-configuration))
(save-window-excursion
(save-excursion
@@ -9322,7 +9341,7 @@ To control what happens when you exit the group, see the
This will allow you to read digests and other similar
documents as newsgroups.
Obeys the standard process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))))
@@ -9371,7 +9390,7 @@ Obeys the standard process/prefix convention."
(defun gnus-summary-button-forward (arg)
"Move point to the next field or button in the article.
With optional ARG, move across that many fields."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(let ((win (or (gnus-get-buffer-window gnus-article-buffer t)
@@ -9385,7 +9404,7 @@ With optional ARG, move across that many fields."
(defun gnus-summary-button-backward (arg)
"Move point to the previous field or button in the article.
With optional ARG, move across that many fields."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(let ((win (or (gnus-get-buffer-window gnus-article-buffer t)
@@ -9442,7 +9461,7 @@ If only one link is found, browse that directly,
otherwise use
completion to select a link. The first link marked in the
article text with `gnus-collect-urls-primary-text' is the
default."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (urls target)
(gnus-summary-select-article)
(gnus-with-article-buffer
@@ -9467,7 +9486,7 @@ default."
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9477,14 +9496,14 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(defun gnus-summary-repeat-search-article-forward ()
"Repeat the previous search forwards."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-last-search-regexp
(error "No previous search"))
(gnus-summary-search-article-forward gnus-last-search-regexp))
(defun gnus-summary-repeat-search-article-backward ()
"Repeat the previous search backwards."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-last-search-regexp
(error "No previous search"))
(gnus-summary-search-article-forward gnus-last-search-regexp t))
@@ -9493,13 +9512,15 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch."
"Search for an article containing REGEXP forward.
If BACKWARD, search backward instead."
(interactive
- (list (read-string
- (format "Search article %s (regexp%s): "
- (if current-prefix-arg "backward" "forward")
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format "Search article %s (regexp%s): "
+ (if current-prefix-arg "backward" "forward")
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ "")))
+ current-prefix-arg)
+ gnus-summary-mode)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp)
@@ -9514,11 +9535,13 @@ If BACKWARD, search backward instead."
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
(interactive
- (list (read-string
- (format "Search article backward (regexp%s): "
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))))
+ (list
+ (read-string
+ (format "Search article backward (regexp%s): "
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ ""))))
+ gnus-summary-mode)
(gnus-summary-search-article-forward regexp 'backward))
(defun gnus-summary-search-article (regexp &optional backward)
@@ -9653,18 +9676,20 @@ that not match REGEXP on HEADER."
If HEADER is an empty string (or nil), the match is done on the entire
article. If BACKWARD (the prefix) is non-nil, search backward instead."
(interactive
- (list (let ((completion-ignore-case t))
- (gnus-completing-read
- "Header name"
- (mapcar #'symbol-name
- (append
- '(Number Subject From Lines Date
- Message-ID Xref References Body)
- gnus-extra-headers))
- 'require-match))
- (read-string "Regexp: ")
- (read-key-sequence "Command: ")
- current-prefix-arg))
+ (list
+ (let ((completion-ignore-case t))
+ (gnus-completing-read
+ "Header name"
+ (mapcar #'symbol-name
+ (append
+ '(Number Subject From Lines Date Message-ID
+ Xref References Body)
+ gnus-extra-headers))
+ 'require-match))
+ (read-string "Regexp: ")
+ (read-key-sequence "Command: ")
+ current-prefix-arg)
+ gnus-summary-mode)
(when (equal header "Body")
(setq header ""))
;; Hidden thread subtrees must be searched as well.
@@ -9688,7 +9713,7 @@ article. If BACKWARD (the prefix) is non-nil, search
backward instead."
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9699,7 +9724,7 @@ article. If BACKWARD (the prefix) is non-nil, search
backward instead."
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9732,7 +9757,9 @@ If the optional first argument FILENAME is nil, send the
image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is a number, prompt the user for the name of the file
to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)))
+ (interactive
+ (list (ps-print-preprint current-prefix-arg))
+ gnus-summary-mode)
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-select-article nil nil 'pseudo article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9772,7 +9799,7 @@ to save in."
"Show a complete version of the current article.
This is only useful if you're looking at a partial version of the
article currently."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-keep-backlog nil)
(gnus-use-cache nil)
(gnus-agent nil)
@@ -9799,7 +9826,7 @@ If ARG (the prefix) is non-nil and not a number, show the
article,
but without running any of the article treatment functions
article. Normally, the keystroke is `C-u g'. When using `C-u
C-u g', show the raw article."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(cond
((numberp arg)
(gnus-summary-show-article t)
@@ -9875,14 +9902,14 @@ C-u g', show the raw article."
(defun gnus-summary-show-raw-article ()
"Show the raw article without any article massaging functions being run."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-show-article t))
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
If ARG is a negative number, turn header display off."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(setq gnus-show-all-headers
(cond ((or (not (numberp arg))
(zerop arg))
@@ -9901,7 +9928,7 @@ If ARG is a negative number, turn header display off."
"Show the headers if they are hidden, or hide them if they are shown.
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((window (and (gnus-buffer-live-p gnus-article-buffer)
(get-buffer-window gnus-article-buffer t))))
(with-current-buffer gnus-article-buffer
@@ -9947,14 +9974,14 @@ If ARG is a negative number, hide the unwanted header
lines."
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-toggle-header 1))
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
With a non-numerical prefix, also rotate headers. A numerical
prefix specifies how many places to rotate each letter forward."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9977,7 +10004,7 @@ invalid IDNA string (`xn--bar' is invalid).
You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/')
installed for this command to work."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9991,7 +10018,7 @@ installed for this command to work."
(defun gnus-summary-morse-message (&optional _arg)
"Morse decode the current article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -10012,7 +10039,7 @@ installed for this command to work."
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
@@ -10042,7 +10069,7 @@ newsgroup that you want to move to have to support the
`request-move'
and `request-accept' functions.
ACTION can be either `move' (the default), `crosspost' or `copy'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(unless action
(setq action 'move))
;; Check whether the source group supports the required functions.
@@ -10348,13 +10375,13 @@ ACTION can be either `move' (the default),
`crosspost' or `copy'."
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Copy the current article to some other group.
Arguments have the same meanings as in `gnus-summary-move-article'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-move-article n to-newsgroup select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group.
Arguments have the same meanings as in `gnus-summary-move-article'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
@@ -10398,7 +10425,8 @@ latter case, they will be copied into the relevant
groups."
(t
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
(cdr (assoc (gnus-completing-read "Server name" ms-alist t)
- ms-alist))))))))
+ ms-alist)))))))
+ gnus-summary-mode)
(unless method
(error "No method given for respooling"))
(if (assoc (symbol-name
@@ -10409,7 +10437,7 @@ latter case, they will be copied into the relevant
groups."
(defun gnus-summary-import-article (file &optional edit)
"Import an arbitrary file into a mail newsgroup."
- (interactive "fImport file: \nP")
+ (interactive "fImport file: \nP" gnus-summary-mode)
(let ((group gnus-newsgroup-name)
atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
@@ -10453,7 +10481,7 @@ latter case, they will be copied into the relevant
groups."
(defun gnus-summary-create-article ()
"Create an article in a mail newsgroup."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((group gnus-newsgroup-name)
(now (current-time))
group-art)
@@ -10477,7 +10505,7 @@ latter case, they will be copied into the relevant
groups."
(defun gnus-summary-article-posted-p ()
"Say whether the current (mail) article is available from news as well.
This will be the case if the article has both been mailed and posted."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((id (mail-header-references (gnus-summary-article-header)))
(gnus-override-method (car (gnus-refer-article-methods))))
(if (gnus-request-head id "")
@@ -10489,7 +10517,7 @@ This will be the case if the article has both been
mailed and posted."
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(when (and (not gnus-group-is-exiting-without-update-p)
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name))
@@ -10558,7 +10586,7 @@ This will be the case if the article has both been
mailed and posted."
"Expunge all expirable articles in the current group.
This means that *all* articles that are marked as expirable will be
deleted forever, right now."
- (interactive)
+ (interactive nil gnus-summary-mode)
(or gnus-expert-user
(gnus-yes-or-no-p
"Are you really, really sure you want to delete all expirable messages?
")
@@ -10578,7 +10606,7 @@ delete these instead.
If `gnus-novice-user' is non-nil you will be asked for
confirmation before the articles are deleted."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
(error "The current newsgroup does not support article deletion"))
@@ -10628,7 +10656,7 @@ If ARG is 2, edit the raw articles even in read-only
groups.
If ARG is 3, edit the articles with the current handles.
Otherwise, allow editing of articles even in read-only
groups."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (force raw current-handles)
(cond
((null arg))
@@ -10708,7 +10736,7 @@ groups."
(defun gnus-summary-edit-article-done (&optional references read-only buffer
no-highlight)
"Make edits to the current article permanent."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
;; The buffer restriction contains the entire article if it exists.
(when (article-goto-body)
@@ -10796,7 +10824,8 @@ groups."
(list
(progn
(message "%s" (concat (this-command-keys) "- "))
- (read-char))))
+ (read-char)))
+ gnus-summary-mode)
(message "")
(gnus-summary-edit-article)
(execute-kbd-macro (concat (this-command-keys) key))
@@ -10809,7 +10838,7 @@ groups."
(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
(with-current-buffer gnus-original-article-buffer
@@ -10839,7 +10868,7 @@ groups."
(defun gnus-summary-respool-trace ()
"Trace where the respool algorithm would put this article.
Display a buffer showing all fancy splitting patterns which matched."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-respool-query nil t))
;; Summary marking commands.
@@ -10848,7 +10877,7 @@ Display a buffer showing all fancy splitting patterns
which matched."
"Mark articles which has the same subject as read, and then select the next.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
@@ -10866,7 +10895,7 @@ If UNMARK is negative, tick articles."
"Mark articles which has the same subject as read.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
@@ -10916,7 +10945,7 @@ If optional argument UNMARK is negative, mark articles
as unread instead."
If N is negative, mark backward instead. If UNMARK is non-nil, remove
the process mark instead. The difference between N and the actual
number of articles marked is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if (and (null n) (and transient-mark-mode mark-active))
(gnus-uu-mark-region (region-beginning) (region-end) unmark)
(setq n (prefix-numeric-value n))
@@ -10940,12 +10969,12 @@ number of articles marked is returned."
"Remove the process mark from the next N articles.
If N is negative, unmark backward instead. The difference between N and
the actual number of articles unmarked is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-as-processable n t))
(defun gnus-summary-unmark-all-processable ()
"Remove the process mark from all articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
(while gnus-newsgroup-processable
(gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
@@ -10969,20 +10998,21 @@ the actual number of articles unmarked is returned."
"Mark N articles forward as expirable.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-expirable-mark))
(defun gnus-summary-mark-as-spam (n)
"Mark N articles forward as spam.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-spam-mark))
(defun gnus-summary-mark-article-as-replied (article)
"Mark ARTICLE as replied to and update the summary line.
ARTICLE can also be a list of articles."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
(let ((articles (if (listp article) article (list article))))
(dolist (article articles)
(unless (numberp article)
@@ -11004,7 +11034,8 @@ ARTICLE can also be a list of articles."
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
(when (or (not (get-buffer gnus-article-buffer))
(not gnus-current-article)
(not gnus-article-current)
@@ -11028,7 +11059,8 @@ ARTICLE can also be a list of articles."
(defun gnus-summary-remove-bookmark (article)
"Remove the bookmark from the current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
@@ -11040,7 +11072,7 @@ ARTICLE can also be a list of articles."
"Mark N articles forward as dormant.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-dormant-mark))
(defun gnus-summary-set-process-mark (article)
@@ -11075,7 +11107,7 @@ If N is negative, mark backwards instead. Mark with
MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned.
If NO-EXPIRE, auto-expiry will be inhibited."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-summary-goto-unread
@@ -11339,20 +11371,20 @@ If NO-EXPIRE, auto-expiry will be inhibited."
"Tick N articles forwards.
If N is negative, tick backwards instead.
The difference between N and the number of articles ticked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-ticked-mark))
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
Optional 2nd argument CLEAR-MARK remove any kinds of mark."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-mark-article article (if clear-mark gnus-unread-mark
gnus-ticked-mark)))
@@ -11361,14 +11393,14 @@ Optional 2nd argument CLEAR-MARK remove any kinds of
mark."
If N is negative, mark backwards instead.
The difference between N and the actual number of articles marked is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read-backward (n)
"Mark the N articles as read backwards.
The difference between N and the actual number of articles marked is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward
(- n) gnus-del-mark gnus-inhibit-user-auto-expire))
@@ -11382,13 +11414,13 @@ MARK specifies a string to be inserted at the
beginning of the line."
"Clear marks from N articles forward.
If N is negative, clear backward instead.
The difference between N and the number of marks cleared is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-unread-mark))
(defun gnus-summary-clear-mark-backward (n)
"Clear marks from N articles backward.
The difference between N and the number of marks cleared is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward (- n) gnus-unread-mark))
(defun gnus-summary-mark-unread-as-read ()
@@ -11421,7 +11453,7 @@ The difference between N and the number of marks
cleared is returned."
"Mark all unread articles between point and mark as read.
If given a prefix, mark all articles between point and mark as read,
even ticked and dormant ones."
- (interactive "r\nP")
+ (interactive "r\nP" gnus-summary-mode)
(save-excursion
(let (article)
(goto-char point)
@@ -11438,7 +11470,7 @@ even ticked and dormant ones."
(defun gnus-summary-mark-below (score mark)
"Mark articles with score less than SCORE with MARK."
- (interactive "P\ncMark: ")
+ (interactive "P\ncMark: " gnus-summary-mode)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
@@ -11452,22 +11484,22 @@ even ticked and dormant ones."
(defun gnus-summary-kill-below (&optional score)
"Mark articles with score below SCORE as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-below score gnus-killed-mark))
(defun gnus-summary-clear-above (&optional score)
"Clear all marks from articles with score above SCORE."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-above score gnus-unread-mark))
(defun gnus-summary-tick-above (&optional score)
"Tick all articles with score above SCORE."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-above score gnus-ticked-mark))
(defun gnus-summary-mark-above (score mark)
"Mark articles with score over SCORE with MARK."
- (interactive "P\ncMark: ")
+ (interactive "P\ncMark: " gnus-summary-mode)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
@@ -11483,7 +11515,7 @@ even ticked and dormant ones."
(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((inhibit-read-only t))
(let ((scored gnus-newsgroup-scored)
headers h)
@@ -11520,7 +11552,7 @@ Note that this function will only catch up the unread
article
in the current summary buffer limitation.
The number of articles marked as read is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(save-excursion
(when (or quietly
@@ -11569,7 +11601,7 @@ The number of articles marked as read is returned."
(defun gnus-summary-catchup-to-here (&optional all)
"Mark all unticked articles before the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
@@ -11581,7 +11613,7 @@ If ALL is non-nil, also mark ticked and dormant
articles as read."
(defun gnus-summary-catchup-from-here (&optional all)
"Mark all unticked articles after (and including) the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
@@ -11594,14 +11626,14 @@ If ALL is non-nil, also mark ticked and dormant
articles as read."
"Mark all articles in this newsgroup as read.
This command is dangerous. Normally, you want \\[gnus-summary-catchup]
instead, which marks only unread articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all unread articles in this group as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read.
If QUIETLY is non-nil, no questions will be asked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(if (and (not (gnus-group-quit-config gnus-newsgroup-name))
@@ -11613,14 +11645,14 @@ If QUIETLY is non-nil, no questions will be asked."
"Mark all articles in this newsgroup as read, and then exit.
This command is dangerous. Normally, you want
\\[gnus-summary-catchup-and-exit]
instead, which marks only unread articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-catchup-and-exit t quietly))
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-group))
@@ -11629,7 +11661,7 @@ read."
"Mark all articles in this group as read and select the previous group.
If given a prefix, mark all articles, unread as well as ticked, as
read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-group nil nil t))
@@ -11705,7 +11737,7 @@ with that article."
(defun gnus-summary-rethread-current ()
"Rethread the thread the current article is part of."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((gnus-show-threads t)
(article (gnus-summary-article-number))
(id (mail-header-id (gnus-summary-article-header)))
@@ -11720,7 +11752,7 @@ with that article."
Note that the re-threading will only work if `gnus-thread-ignore-subject'
is non-nil or the Subject: of both articles are the same."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless (not (gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
@@ -11739,9 +11771,10 @@ is non-nil or the Subject: of both articles are the
same."
"Make PARENT the parent of CHILDREN.
When called interactively, PARENT is the current article and CHILDREN
are the process-marked articles."
- (interactive
- (list (gnus-summary-article-number)
- (gnus-summary-work-articles nil)))
+ (interactive (list
+ (gnus-summary-article-number)
+ (gnus-summary-work-articles nil))
+ gnus-summary-mode)
(dolist (child children)
(save-window-excursion
(let ((gnus-article-buffer " *reparent*"))
@@ -11774,7 +11807,7 @@ are the process-marked articles."
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
(setq gnus-show-threads
(if (null arg) (not gnus-show-threads)
@@ -11786,7 +11819,7 @@ If ARG is positive number, turn showing conversation
threads on."
(defun gnus-summary-show-all-threads ()
"Show all threads."
- (interactive)
+ (interactive nil gnus-summary-mode)
(remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
@@ -11796,7 +11829,7 @@ If ARG is positive number, turn showing conversation
threads on."
(defun gnus-summary-show-thread ()
"Show thread subtrees.
Returns nil if no thread was there to be shown."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((orig (point))
(end (point-at-eol))
(end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
@@ -11837,7 +11870,7 @@ Returns nil if no thread was there to be shown."
"Hide all thread subtrees.
If PREDICATE is supplied, threads that satisfy this predicate
will not be hidden."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
(goto-char (point-min))
(let ((end nil)
@@ -11856,7 +11889,7 @@ will not be hidden."
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
Returns nil if no threads were there to be hidden."
- (interactive)
+ (interactive nil gnus-summary-mode)
(beginning-of-line)
(let ((start (point))
(starteol (line-end-position))
@@ -11908,7 +11941,7 @@ Returns the difference between N and the number of
skips actually
done.
If SILENT, don't output messages."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -11924,7 +11957,7 @@ If SILENT, don't output messages."
"Go to the same level previous N'th thread.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-thread (- n)))
(defun gnus-summary-go-down-thread ()
@@ -11944,7 +11977,7 @@ done."
If N is negative, go up instead.
Returns the difference between N and how many steps down that were
taken."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((up (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -11961,18 +11994,18 @@ taken."
If N is negative, go down instead.
Returns the difference between N and how many steps down that were
taken."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-down-thread (- n)))
(defun gnus-summary-top-thread ()
"Go to the top of the thread."
- (interactive)
+ (interactive nil gnus-summary-mode)
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
(defun gnus-summary-expire-thread ()
"Mark articles under current thread as expired."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-kill-thread 0))
(defun gnus-summary-kill-thread (&optional unmark)
@@ -11980,7 +12013,7 @@ taken."
If the prefix argument is positive, remove any kinds of marks.
If the prefix argument is zero, mark thread as expired.
If the prefix argument is negative, tick articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread))
@@ -12015,82 +12048,82 @@ If the prefix argument is negative, tick articles
instead."
(defun gnus-summary-sort-by-number (&optional reverse)
"Sort the summary buffer by article number.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'number reverse))
(defun gnus-summary-sort-by-most-recent-number (&optional reverse)
"Sort the summary buffer by most recent article number.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'most-recent-number reverse))
(defun gnus-summary-sort-by-random (&optional reverse)
"Randomize the order in the summary buffer.
Argument REVERSE means to randomize in reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'random reverse))
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort the summary buffer by author name alphabetically.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-recipient (&optional reverse)
"Sort the summary buffer by recipient name alphabetically.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'recipient reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
"Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'subject reverse))
(defun gnus-summary-sort-by-date (&optional reverse)
"Sort the summary buffer by date.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'date reverse))
(defun gnus-summary-sort-by-most-recent-date (&optional reverse)
"Sort the summary buffer by most recent date.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'most-recent-date reverse))
(defun gnus-summary-sort-by-score (&optional reverse)
"Sort the summary buffer by score.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'score reverse))
(defun gnus-summary-sort-by-lines (&optional reverse)
"Sort the summary buffer by the number of lines.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'lines reverse))
(defun gnus-summary-sort-by-chars (&optional reverse)
"Sort the summary buffer by article length.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'chars reverse))
(defun gnus-summary-sort-by-marks (&optional reverse)
"Sort the summary buffer by article marks.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'marks reverse))
(defun gnus-summary-sort-by-original (&optional _reverse)
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
@@ -12139,7 +12172,7 @@ will not be marked as saved.
The `gnus-prompt-before-saving' variable says how prompting is
performed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(save-buffer (save-excursion
@@ -12208,7 +12241,7 @@ is neither omitted nor the symbol `r', force including
all headers
regardless of the `:headers' property. If it is the symbol `r',
articles that are not decoded and include all headers will be piped
no matter what the properties `:decode' and `:headers' are."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-summary-mode)
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(result-buffer shell-command-buffer-name)
@@ -12260,7 +12293,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
(gnus-summary-save-article arg)))
@@ -12271,7 +12304,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
@@ -12282,7 +12315,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
@@ -12293,7 +12326,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-write-to-file))
(gnus-summary-save-article arg)))
@@ -12304,7 +12337,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
@@ -12315,7 +12348,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
(gnus-summary-save-article arg)))
@@ -12326,14 +12359,14 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
(gnus-summary-save-article arg t)))
(defun gnus-summary-pipe-message (program)
"Pipe the current article through PROGRAM."
- (interactive "sProgram: ")
+ (interactive "sProgram: " gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -12451,7 +12484,8 @@ If REVERSE, save parts that do not match TYPE."
(read-directory-name "Save to directory: "
gnus-summary-save-parts-last-directory
nil t))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
gnus-article-prepare-hook
@@ -12590,12 +12624,12 @@ If REVERSE, save parts that do not match TYPE."
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(gnus-group-edit-global-kill article))
(defun gnus-summary-edit-local-kill ()
"Edit a local kill file applied to the current newsgroup."
- (interactive)
+ (interactive nil gnus-summary-mode)
(setq gnus-current-headers (gnus-summary-article-header))
(gnus-group-edit-local-kill
(gnus-summary-article-number) gnus-newsgroup-name))
@@ -12893,7 +12927,7 @@ UNREAD is a sorted list."
"Display the current article buffer fully MIME-buttonized.
If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
treated as multipart/mixed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-unbuttonized-mime-types nil)
(gnus-mime-display-multipart-as-mixed show-all-parts))
@@ -12901,7 +12935,7 @@ treated as multipart/mixed."
(defun gnus-summary-repair-multipart (article)
"Add a Content-Type header to a multipart article without one."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(gnus-with-article article
(message-narrow-to-head)
(message-remove-header "Mime-Version")
@@ -12921,7 +12955,7 @@ treated as multipart/mixed."
(defun gnus-summary-toggle-display-buttonized ()
"Toggle the buttonizing of the article buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(require 'gnus-art)
(if (setq gnus-inhibit-mime-unbuttonizing
(not gnus-inhibit-mime-unbuttonizing))
@@ -12976,7 +13010,7 @@ If N is negative, move in reverse order.
The difference between N and the actual number of articles marked is
returned."
name (cadr lway))
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
(defun gnus-summary-generic-mark (n mark move unread)
@@ -13059,7 +13093,7 @@ returned."
"Insert all old articles in this group.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
older len)
@@ -13133,7 +13167,7 @@ If ALL is a number, fetch this number of articles."
(defun gnus-summary-insert-new-articles ()
"Insert all new articles in this group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
(old-high gnus-newsgroup-highest)
(nnmail-fetched-sources (list t))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 3253b78..b3d17bc 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -146,7 +146,8 @@ See Info node `(gnus)Formatting Variables'."
(defun gnus-topic-jump-to-topic (topic)
"Go to TOPIC."
(interactive
- (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
+ (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))
+ gnus-topic-mode)
(let ((inhibit-read-only t))
(dolist (topic (gnus-current-topics topic))
(unless (gnus-topic-goto-topic topic)
@@ -235,12 +236,12 @@ If RECURSIVE is t, return groups in its subtopics too."
(defun gnus-topic-goto-previous-topic (n)
"Go to the N'th previous topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(gnus-topic-goto-next-topic (- n)))
(defun gnus-topic-goto-next-topic (n)
"Go to the N'th next topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(let ((backward (< n 0))
(n (abs n))
(topic (gnus-current-topic)))
@@ -661,7 +662,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topics-containing-group (group)
"Update all topics that have GROUP as a member."
- (when (and (eq major-mode 'gnus-group-mode)
+ (when (and (eq major-mode 'gnus-topic-mode)
gnus-topic-mode)
(save-excursion
(let ((alist gnus-topic-alist))
@@ -677,7 +678,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topic ()
"Update all parent topics to the current group."
- (when (and (eq major-mode 'gnus-group-mode)
+ (when (and (eq major-mode 'gnus-topic-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
(m (point-marker))
@@ -1122,7 +1123,9 @@ articles in the topic and its subtopics."
(define-minor-mode gnus-topic-mode
"Minor mode for topicsifying Gnus group buffers."
- :lighter " Topic" :keymap gnus-topic-mode-map
+ :lighter " Topic"
+ :keymap gnus-topic-mode-map
+ :interactive (gnus-group-mode)
(if (not (derived-mode-p 'gnus-group-mode))
(setq gnus-topic-mode nil)
;; Infest Gnus with topics.
@@ -1172,7 +1175,7 @@ articles in the group. If ALL is a negative number,
fetch this
number of the earliest articles in the group.
If performed over a topic line, toggle folding the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(if (gnus-group-topic-p)
@@ -1184,13 +1187,13 @@ If performed over a topic line, toggle folding the
topic."
(defun gnus-mouse-pick-topic (e)
"Select the group or topic under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-topic-mode)
(mouse-set-point e)
(gnus-topic-read-group nil))
(defun gnus-topic-expire-articles (topic)
"Expire articles in this topic or group."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-expire-articles)
(save-excursion
@@ -1205,7 +1208,7 @@ If performed over a topic line, toggle folding the topic."
(defun gnus-topic-catchup-articles (topic)
"Catchup this topic or group.
Also see `gnus-group-catchup'."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-catchup-current)
(save-excursion
@@ -1232,7 +1235,7 @@ be auto-selected upon group entry. If GROUP is non-nil,
fetch
that group.
If performed over a topic line, toggle folding the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(if (gnus-group-topic-p)
@@ -1247,7 +1250,8 @@ When used interactively, PARENT will be the topic under
point."
(interactive
(list
(read-string "New topic: ")
- (gnus-current-topic)))
+ (gnus-current-topic))
+ gnus-topic-mode)
;; Check whether this topic already exists.
(when (gnus-topic-find-topology topic)
(error "Topic already exists"))
@@ -1284,7 +1288,8 @@ If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
(gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t
- nil 'gnus-topic-history)))
+ nil 'gnus-topic-history))
+ gnus-topic-mode)
(let ((use-marked (and (not n) (not (and transient-mark-mode mark-active))
gnus-group-marked t))
(groups (gnus-group-process-prefix n))
@@ -1309,7 +1314,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-remove-group (&optional n)
"Remove the current group from the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(let ((use-marked (and (not n) (not (and transient-mark-mode mark-active))
gnus-group-marked t))
(groups (gnus-group-process-prefix n)))
@@ -1331,12 +1336,13 @@ If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
(gnus-completing-read
- "Copy to topic" (mapcar #'car gnus-topic-alist) t)))
+ "Copy to topic" (mapcar #'car gnus-topic-alist) t))
+ gnus-topic-mode)
(gnus-topic-move-group n topic t))
(defun gnus-topic-kill-group (&optional n discard)
"Kill the next N groups."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if (gnus-group-topic-p)
(let ((topic (gnus-group-topic-name)))
(push (cons
@@ -1356,7 +1362,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-yank-group (&optional arg)
"Yank the last topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(if gnus-topic-killed-topics
(let* ((previous
(or (gnus-group-topic-name)
@@ -1405,7 +1411,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-hide-topic (&optional permanent)
"Hide the current topic.
If PERMANENT, make it stay hidden in subsequent sessions as well."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (gnus-current-topic)
(gnus-topic-goto-topic (gnus-current-topic))
(if permanent
@@ -1418,7 +1424,7 @@ If PERMANENT, make it stay hidden in subsequent sessions
as well."
(defun gnus-topic-show-topic (&optional permanent)
"Show the hidden topic.
If PERMANENT, make it stay shown in subsequent sessions as well."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (gnus-group-topic-p)
(if (not permanent)
(gnus-topic-remove-topic t nil)
@@ -1433,9 +1439,11 @@ If PERMANENT, make it stay shown in subsequent sessions
as well."
(defun gnus-topic-mark-topic (topic &optional unmark non-recursive)
"Mark all groups in the TOPIC with the process mark.
If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics."
- (interactive (list (gnus-group-topic-name)
- nil
- (and current-prefix-arg t)))
+ (interactive
+ (list (gnus-group-topic-name)
+ nil
+ (and current-prefix-arg t))
+ gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-mark-group)
(save-excursion
@@ -1450,14 +1458,15 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark
its subtopics."
If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(interactive (list (gnus-group-topic-name)
nil
- (and current-prefix-arg t)))
+ (and current-prefix-arg t))
+ gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-unmark-group)
(gnus-topic-mark-topic topic t non-recursive)))
(defun gnus-topic-get-new-news-this-topic (&optional n)
"Check for new news in the current topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if (not (gnus-group-topic-p))
(gnus-group-get-new-news-this-group n)
(let* ((topic (gnus-group-topic-name))
@@ -1475,7 +1484,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark
its subtopics."
(list
(setq topic (gnus-completing-read "Move to topic"
(mapcar #'car gnus-topic-alist) t))
- (read-string (format "Move to %s (regexp): " topic))))))
+ (read-string (format "Move to %s (regexp): " topic)))))
+ gnus-topic-mode)
(gnus-group-mark-regexp regexp)
(gnus-topic-move-group nil topic copyp))
@@ -1486,12 +1496,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't
unmark its subtopics."
(mapcar #'car gnus-topic-alist) t)))
(nreverse
(list topic
- (read-string (format "Copy to %s (regexp): " topic))))))
+ (read-string (format "Copy to %s (regexp): " topic)))))
+ gnus-topic-mode)
(gnus-topic-move-matching regexp topic t))
(defun gnus-topic-delete (topic)
"Delete a topic."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(unless topic
(error "No topic to be deleted"))
(let ((entry (assoc topic gnus-topic-alist))
@@ -1512,7 +1523,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark
its subtopics."
(interactive
(let ((topic (gnus-current-topic)))
(list topic
- (read-string (format "Rename %s to: " topic) topic))))
+ (read-string (format "Rename %s to: " topic) topic)))
+ gnus-topic-mode)
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
(error "Topic `%s' already exists" new-name))
@@ -1535,7 +1547,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark
its subtopics."
(defun gnus-topic-indent (&optional unindent)
"Indent a topic -- make it a sub-topic of the previous topic.
If UNINDENT, remove an indentation."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if unindent
(gnus-topic-unindent)
(let* ((topic (gnus-current-topic))
@@ -1555,7 +1567,7 @@ If UNINDENT, remove an indentation."
(defun gnus-topic-unindent ()
"Unindent a topic."
- (interactive)
+ (interactive nil gnus-topic-mode)
(let* ((topic (gnus-current-topic))
(parent (gnus-topic-parent-topic topic))
(grandparent (gnus-topic-parent-topic parent)))
@@ -1574,7 +1586,7 @@ If UNINDENT, remove an indentation."
(defun gnus-topic-list-active (&optional force)
"List all groups that Gnus knows about in a topicsified fashion.
If FORCE, always re-read the active file."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when force
(gnus-get-killed-groups))
(gnus-topic-grok-active force)
@@ -1585,7 +1597,7 @@ If FORCE, always re-read the active file."
(defun gnus-topic-toggle-display-empty-topics ()
"Show/hide topics that have no unread articles."
- (interactive)
+ (interactive nil gnus-topic-mode)
(setq gnus-topic-display-empty-topics
(not gnus-topic-display-empty-topics))
(gnus-group-list-groups)
@@ -1598,7 +1610,7 @@ If FORCE, always re-read the active file."
(defun gnus-topic-edit-parameters (group)
"Edit the group parameters of GROUP.
If performed on a topic, edit the topic parameters instead."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-topic-mode)
(if group
(gnus-group-edit-group-parameters group)
(if (not (gnus-group-topic-p))
@@ -1642,7 +1654,8 @@ If performed on a topic, edit the topic parameters
instead."
(defun gnus-topic-sort-groups (func &optional reverse)
"Sort the current topic according to FUNC.
If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
+ (interactive (list gnus-group-sort-function current-prefix-arg)
+ gnus-topic-mode)
(let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
(gnus-topic-sort-topic
topic (gnus-make-sort-function func) reverse)
@@ -1651,43 +1664,43 @@ If REVERSE, reverse the sorting order."
(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
"Sort the current topic alphabetically by group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
(defun gnus-topic-sort-groups-by-unread (&optional reverse)
"Sort the current topic by number of unread articles.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
(defun gnus-topic-sort-groups-by-level (&optional reverse)
"Sort the current topic by group level.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
(defun gnus-topic-sort-groups-by-score (&optional reverse)
"Sort the current topic by group score.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
(defun gnus-topic-sort-groups-by-rank (&optional reverse)
"Sort the current topic by group rank.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
(defun gnus-topic-sort-groups-by-method (&optional reverse)
"Sort the current topic alphabetically by backend name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
(defun gnus-topic-sort-groups-by-server (&optional reverse)
"Sort the current topic alphabetically by server name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-server reverse))
(defun gnus-topic-sort-topics-1 (top reverse)
@@ -1708,7 +1721,8 @@ If REVERSE, reverse the sorting order."
(list (gnus-completing-read "Sort topics in"
(mapcar #'car gnus-topic-alist) t
(gnus-current-topic))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-topic-mode)
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
gnus-topic-topology)))
(gnus-topic-sort-topics-1 topic-topology reverse)
@@ -1721,7 +1735,8 @@ If REVERSE, reverse the sorting order."
(interactive
(list
(gnus-group-topic-name)
- (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)))
+ (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t))
+ gnus-topic-mode)
(unless (and current to)
(error "Can't find topic"))
(let ((current-top (cdr (gnus-topic-find-topology current)))
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 32a8785..bd9a1a3 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -355,7 +355,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(defun gnus-uu-decode-uu (&optional n)
"Uudecodes the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-uustrip-article n))
(defun gnus-uu-decode-uu-and-save (n dir)
@@ -364,13 +364,14 @@ didn't work, and overwrite existing files. Otherwise,
ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Uudecode and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-uustrip-article n dir nil nil t))
(defun gnus-uu-decode-unshar (&optional n)
"Unshars the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t))
(defun gnus-uu-decode-unshar-and-save (n dir)
@@ -379,8 +380,9 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Unshar and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t))
(defun gnus-uu-decode-save (n file)
@@ -391,7 +393,8 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(read-directory-name
"Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir)
(read-file-name
- "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))))
+ "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(setq gnus-uu-saved-article-name file)
(gnus-uu-decode-with-method #'gnus-uu-save-article n nil t))
@@ -401,8 +404,9 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Unbinhex and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
@@ -414,14 +418,15 @@ didn't work, and overwrite existing files. Otherwise,
ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "yEnc decode and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(setq gnus-uu-yenc-article-name nil)
(gnus-uu-decode-with-method #'gnus-uu-yenc-article n dir nil t))
(defun gnus-uu-decode-uu-view (&optional n)
"Uudecodes and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu n)))
@@ -431,13 +436,14 @@ didn't work, and overwrite existing files. Otherwise,
ask each time."
(list current-prefix-arg
(read-file-name "Uudecode, view and save in dir: "
gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu-and-save n dir)))
(defun gnus-uu-decode-unshar-view (&optional n)
"Unshars and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-unshar n)))
@@ -447,7 +453,8 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(list current-prefix-arg
(read-file-name "Unshar, view and save in dir: "
gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-unshar-and-save n dir)))
@@ -459,7 +466,8 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(read-directory-name "Save articles in dir: "
gnus-uu-default-dir gnus-uu-default-dir)
(read-file-name "Save articles in file: "
- gnus-uu-default-dir gnus-uu-default-dir))))
+ gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-save n file)))
@@ -468,7 +476,8 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(interactive
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
- gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-uu-default-dir gnus-uu-default-dir))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
@@ -480,7 +489,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(defun gnus-uu-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(let ((gnus-uu-save-in-digest t)
(file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward")))
@@ -546,7 +555,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(defun gnus-uu-digest-post-forward (&optional n)
"Digest and forward to a newsgroup."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-digest-mail-forward n t))
;; Process marking.
@@ -576,7 +585,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
"Set the process mark on articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP.
Optional UNMARK non-nil means unmark instead of mark."
- (interactive "sMark (regexp): \nP")
+ (interactive "sMark (regexp): \nP" gnus-article-mode gnus-summary-mode)
(save-excursion
(let* ((articles (gnus-uu-find-articles-matching regexp))
(new-marked (gnus-new-processable unmark articles)))
@@ -590,12 +599,12 @@ Optional UNMARK non-nil means unmark instead of mark."
(defun gnus-uu-unmark-by-regexp (regexp)
"Remove the process mark from articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP."
- (interactive "sUnmark (regexp): ")
+ (interactive "sUnmark (regexp): " gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-by-regexp regexp t))
(defun gnus-uu-mark-series (&optional silent)
"Mark the current series with the process mark."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let* ((articles (gnus-uu-find-articles-matching))
(l (length articles)))
(while articles
@@ -608,7 +617,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-region (beg end &optional unmark)
"Set the process mark on all articles between point and mark."
- (interactive "r")
+ (interactive "r" gnus-article-mode gnus-summary-mode)
(save-excursion
(goto-char beg)
(while (< (point) end)
@@ -620,22 +629,22 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-unmark-region (beg end)
"Remove the process mark from all articles between point and mark."
- (interactive "r")
+ (interactive "r" gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region beg end t))
(defun gnus-uu-mark-buffer ()
"Set the process mark on all articles in the buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region (point-min) (point-max)))
(defun gnus-uu-unmark-buffer ()
"Remove the process mark on all articles in the buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region (point-min) (point-max) t))
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-save-hidden-threads
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
@@ -646,7 +655,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-unmark-thread ()
"Unmarks all articles downwards in this thread."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-remove-process-mark
(gnus-summary-article-number))
@@ -656,7 +665,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-invert-processable ()
"Invert the list of process-marked articles."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((data gnus-newsgroup-data)
number)
(save-excursion
@@ -669,7 +678,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-over (&optional score)
"Mark all articles with a score over SCORE (the prefix)."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((score (or score gnus-summary-default-score 0))
(data gnus-newsgroup-data))
(save-excursion
@@ -684,7 +693,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-sparse ()
"Mark all series that have some articles marked."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((marked (nreverse gnus-newsgroup-processable))
subject articles total headers)
(unless marked
@@ -708,7 +717,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-all ()
"Mark all articles in \"series\" order."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(setq gnus-newsgroup-processable nil)
(save-excursion
(let ((data gnus-newsgroup-data)
@@ -728,33 +737,33 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-decode-postscript (&optional n)
"Gets PostScript of the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n))
(defun gnus-uu-decode-postscript-view (&optional n)
"Gets and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-postscript n)))
(defun gnus-uu-decode-postscript-and-save (n dir)
"Extracts PostScript and saves the current article."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-directory-name "Save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ (interactive (list current-prefix-arg
+ (file-name-as-directory
+ (read-directory-name "Save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article
n dir nil nil t))
(defun gnus-uu-decode-postscript-and-save-view (n dir)
"Decodes, views and saves the resulting file."
- (interactive
- (list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ (interactive (list current-prefix-arg
+ (read-file-name "Where do you want to save the file(s)? "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-postscript-and-save n dir)))
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index b7e6b2a..ec36011 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -72,7 +72,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
(gnus-summary-save-article arg)))
@@ -80,7 +80,7 @@ save those articles instead."
(declare-function vm-save-message "ext:vm-save" (folder &optional count))
(defun gnus-summary-save-in-vm (&optional folder)
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(require 'vm)
(setq folder
(gnus-read-save-file-name
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index e8e5629..7f2f01b 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2513,7 +2513,7 @@ are always t.")
'(("info" :interactive t Info-goto-node)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
- ("message" :interactive t
+ ("message" :interactive (message-mode)
message-send-and-exit message-yank-original)
("babel" babel-as-string)
("nnmail" nnmail-split-fancy nnmail-article-group)
@@ -2530,7 +2530,7 @@ are always t.")
("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
- ("gnus-mh" :interactive t gnus-summary-save-in-folder)
+ ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder)
("gnus-demon" gnus-demon-add-scanmail
gnus-demon-add-rescan gnus-demon-add-scan-timestamps
gnus-demon-add-disconnection gnus-demon-add-handler
@@ -2545,7 +2545,7 @@ are always t.")
("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
gnus-server-server-name)
("gnus-srvr" gnus-browse-foreign-server)
- ("gnus-cite" :interactive t
+ ("gnus-cite" :interactive (gnus-article-mode gnus-summary-mode)
gnus-article-highlight-citation gnus-article-hide-citation-maybe
gnus-article-hide-citation gnus-article-fill-cited-article
gnus-article-hide-citation-in-followups
@@ -2561,29 +2561,34 @@ are always t.")
gnus-cache-enter-remove-article gnus-cached-article-p
gnus-cache-open gnus-cache-close gnus-cache-update-article
gnus-cache-articles-in-group)
- ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+ ("gnus-cache" :interactive (gnus-summary-mode)
+ gnus-summary-insert-cached-articles gnus-cache-enter-article
gnus-cache-remove-article gnus-summary-insert-cached-articles)
+ ("gnus-cache" :interactive t gnus-jog-cache)
("gnus-score" :interactive t
+ gnus-score-flush-cache gnus-score-close)
+ ("gnus-score" :interactive (gnus-summary-mode)
gnus-summary-increase-score gnus-summary-set-score
gnus-summary-raise-thread gnus-summary-raise-same-subject
gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
gnus-summary-lower-thread gnus-summary-lower-same-subject
gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
gnus-summary-current-score gnus-score-delta-default
- gnus-score-flush-cache gnus-score-close
gnus-possibly-score-headers gnus-score-followup-article
gnus-score-followup-thread)
("gnus-score"
(gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-score-find-trace gnus-score-file-name)
- ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
- ("gnus-topic" :interactive t gnus-topic-mode)
+ ("gnus-cus" :interactive (gnus-group-mode) gnus-group-customize)
+ ("gnus-cus" :interactive (gnus-summary-mode) gnus-score-customize)
+ ("gnus-topic" :interactive (gnus-group-mode) gnus-topic-mode)
("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
gnus-subscribe-topics)
- ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
+ ("gnus-salt" :interactive (gnus-summary-mode)
+ gnus-pick-mode gnus-binary-mode)
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
- ("gnus-uu" :interactive t
+ ("gnus-uu" :interactive (gnus-article-mode gnus-summary-mode)
gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
gnus-uu-mark-by-regexp gnus-uu-mark-all
@@ -2598,12 +2603,13 @@ are always t.")
("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
- ("gnus-msg" :interactive t
- gnus-group-post-news gnus-group-mail gnus-group-news
+ ("gnus-msg" :interactive (gnus-group-mode)
+ gnus-group-post-news gnus-group-mail gnus-group-news)
+ ("gnus-msg" :interactive (gnus-summary-mode)
gnus-summary-post-news gnus-summary-news-other-window
gnus-summary-followup gnus-summary-followup-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
- gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
+ gnus-summary-reply gnus-summary-reply-with-original
gnus-summary-mail-forward gnus-summary-mail-other-window
gnus-summary-resend-message gnus-summary-resend-bounced-mail
gnus-summary-wide-reply gnus-summary-followup-to-mail
@@ -2611,7 +2617,9 @@ are always t.")
gnus-summary-wide-reply-with-original
gnus-summary-post-forward gnus-summary-wide-reply-with-original
gnus-summary-post-forward)
- ("gnus-picon" :interactive t gnus-treat-from-picon)
+ ("gnus-msg" gnus-post-news)
+ ("gnus-picon" :interactive (gnus-article-mode gnus-summary-mode)
+ gnus-treat-from-picon)
("smiley" :interactive t smiley-region)
("gnus-win" gnus-configure-windows gnus-add-configuration)
("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
@@ -2634,7 +2642,7 @@ are always t.")
gnus-request-article-this-buffer gnus-article-mode
gnus-article-setup-buffer gnus-narrow-to-page
gnus-article-delete-invisible-text gnus-treat-article)
- ("gnus-art" :interactive t
+ ("gnus-art" :interactive (gnus-summary-mode gnus-article-mode)
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike
gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
@@ -2646,7 +2654,6 @@ are always t.")
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
- ;;gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
@@ -2671,12 +2678,13 @@ are always t.")
gnus-agent-store-article gnus-agent-group-covered-p)
("gnus-agent" :interactive t
gnus-unplugged gnus-agentize gnus-agent-batch)
- ("gnus-vm" :interactive t gnus-summary-save-in-vm
+ ("gnus-vm" :interactive (gnus-summary-mode) gnus-summary-save-in-vm
gnus-summary-save-article-vm)
("compface" uncompface)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
+ ("gnus-draft" :interactive (gnus-summary-mode) gnus-draft-mode)
+ ("gnus-draft" :interactive t gnus-group-send-queue)
("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
- ("gnus-mlspl" :interactive t gnus-group-split-setup
+ ("gnus-mlspl" :interactive (gnus-group-mode) gnus-group-split-setup
gnus-group-split-update)
("gnus-delay" gnus-delay-initialize))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 5a5dbce..ee98099 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2334,7 +2334,8 @@ Leading \"Re: \" is not stripped by this function. Use
the function
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
(interactive
(list
- (read-from-minibuffer "New subject: ")))
+ (read-from-minibuffer "New subject: "))
+ message-mode)
(cond ((and (not (or (null new-subject) ; new subject not empty
(zerop (string-width new-subject))
(string-match "^[ \t]*$" new-subject))))
@@ -2364,7 +2365,7 @@ Leading \"Re: \" is not stripped by this function. Use
the function
"Mark some region in the current article with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'.
If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
- (interactive "r\nP")
+ (interactive "r\nP" message-mode)
(save-excursion
;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
@@ -2376,7 +2377,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and
\"#v-\")."
"Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'.
If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
- (interactive "fFile to insert: \nP")
+ (interactive "fFile to insert: \nP" message-mode)
;; reverse insertion to get correct result.
(let ((p (point)))
(insert (if verbatim "#v-\n" message-mark-insert-end))
@@ -2390,7 +2391,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and
\"#v-\")."
The note can be customized using `message-archive-note'. When called with a
prefix argument, ask for a text to insert. If you don't want the note in the
body, set `message-archive-note' to nil."
- (interactive)
+ (interactive nil message-mode)
(if current-prefix-arg
(setq message-archive-note
(read-from-minibuffer "Reason for No-Archive: "
@@ -2416,7 +2417,8 @@ With prefix-argument just set Follow-Up, don't
cross-post."
gnus-newsrc-alist)
nil nil '("poster" . 0)
(if (boundp 'gnus-group-history)
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ message-mode)
(message-remove-header "Follow[Uu]p-[Tt]o" t)
(message-goto-newsgroups)
(beginning-of-line)
@@ -2493,7 +2495,8 @@ With prefix-argument just set Follow-Up, don't
cross-post."
gnus-newsrc-alist)
nil nil '("poster" . 0)
(if (boundp 'gnus-group-history)
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ message-mode)
(when (fboundp 'gnus-group-real-name)
(setq target-group (gnus-group-real-name target-group)))
(cond ((not (or (null target-group) ; new subject not empty
@@ -2528,7 +2531,7 @@ With prefix-argument just set Follow-Up, don't
cross-post."
(defun message-reduce-to-to-cc ()
"Replace contents of To: header with contents of Cc: or Bcc: header."
- (interactive)
+ (interactive nil message-mode)
(let ((cc-content
(save-restriction (message-narrow-to-headers)
(message-fetch-field "cc")))
@@ -2694,7 +2697,7 @@ Point is left at the beginning of the narrowed-to region."
(defun message-sort-headers ()
"Sort headers of the current message according to
`message-header-format-alist'."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(let ((max (1+ (length message-header-format-alist)))
@@ -2715,7 +2718,7 @@ Point is left at the beginning of the narrowed-to region."
(defun message-kill-address ()
"Kill the address under point."
- (interactive)
+ (interactive nil message-mode)
(let ((start (point)))
(message-skip-to-next-address)
(kill-region start (if (bolp) (1- (point)) (point)))))
@@ -3208,79 +3211,79 @@ Like `text-mode', but with these additional commands:
(defun message-goto-to ()
"Move point to the To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "To"))
(defun message-goto-from ()
"Move point to the From header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "From"))
(defun message-goto-subject ()
"Move point to the Subject header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Subject"))
(defun message-goto-cc ()
"Move point to the Cc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Cc" "To"))
(defun message-goto-bcc ()
"Move point to the Bcc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
"Move point to the Fcc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Fcc" "To" "Newsgroups"))
(defun message-goto-reply-to ()
"Move point to the Reply-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Reply-To" "Subject"))
(defun message-goto-newsgroups ()
"Move point to the Newsgroups header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Newsgroups"))
(defun message-goto-distribution ()
"Move point to the Distribution header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Distribution"))
(defun message-goto-followup-to ()
"Move point to the Followup-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Keywords" "Subject"))
(defun message-goto-summary ()
"Move point to the Summary header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Summary" "Subject"))
@@ -3288,7 +3291,7 @@ Like `text-mode', but with these additional commands:
(defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body.
Returns point."
- (interactive "p")
+ (interactive "p" message-mode)
(when interactive
(when (looking-at "[ \t]*\n")
(expand-abbrev))
@@ -3315,7 +3318,7 @@ Returns point."
(defun message-goto-eoh (&optional interactive)
"Move point to the end of the headers."
- (interactive "p")
+ (interactive "p" message-mode)
(message-goto-body interactive)
(forward-line -1))
@@ -3323,7 +3326,7 @@ Returns point."
"Move point to the beginning of the message signature.
If there is no signature in the article, go to the end and
return nil."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(goto-char (point-min))
(if (re-search-forward message-signature-separator nil t)
@@ -3342,7 +3345,7 @@ in the current mail buffer, and appends the current
`user-mail-address'.
If the optional argument INCLUDE-CC is non-nil, the addresses in the
Cc: header are also put into the MFT."
- (interactive "P")
+ (interactive "P" message-mode)
(let* (cc tos)
(save-restriction
(message-narrow-to-headers)
@@ -3360,7 +3363,7 @@ Cc: header are also put into the MFT."
"Insert a To header that points to the author of the article being replied
to.
If the original author requested not to be sent mail, don't insert unless the
prefix FORCE is given."
- (interactive "P")
+ (interactive "P" message-mode)
(let* ((mct (message-fetch-reply-field "mail-copies-to"))
(dont (and mct (or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))))
@@ -3379,7 +3382,7 @@ prefix FORCE is given."
(defun message-insert-wide-reply ()
"Insert To and Cc headers as if you were doing a wide reply."
- (interactive)
+ (interactive nil message-mode)
(let ((headers (message-with-reply-buffer
(message-get-reply-headers t))))
(message-carefully-insert-headers headers)))
@@ -3424,7 +3427,7 @@ or in the synonym headers, defined by
`message-header-synonyms'."
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
- (interactive)
+ (interactive nil message-mode)
(let ((follow-to
(and (buffer-live-p message-reply-buffer)
(with-current-buffer message-reply-buffer
@@ -3440,7 +3443,7 @@ or in the synonym headers, defined by
`message-header-synonyms'."
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
- (interactive)
+ (interactive nil message-mode)
(let ((old-newsgroups (mail-fetch-field "newsgroups"))
(new-newsgroups (message-fetch-reply-field "newsgroups"))
(first t)
@@ -3475,13 +3478,13 @@ or in the synonym headers, defined by
`message-header-synonyms'."
(defun message-widen-and-recenter ()
"Widen the buffer and go to the start."
- (interactive)
+ (interactive nil message-mode)
(widen)
(goto-char (point-min)))
(defun message-delete-not-region (beg end)
"Delete everything in the body of the current message outside of the region."
- (interactive "r")
+ (interactive "r" message-mode)
(let (citeprefix)
(save-excursion
(goto-char beg)
@@ -3508,7 +3511,7 @@ or in the synonym headers, defined by
`message-header-synonyms'."
"Kill all text up to the signature.
If a numeric argument or prefix arg is given, leave that number
of lines before the signature intact."
- (interactive "P")
+ (interactive "P" message-mode)
(save-excursion
(save-restriction
(let ((point (point)))
@@ -3526,7 +3529,7 @@ of lines before the signature intact."
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
Prefix arg means justify as well."
- (interactive (list (if current-prefix-arg 'full)))
+ (interactive (list (if current-prefix-arg 'full)) message-mode)
(unless (message-in-body-p)
(error "This command only works in the body of the message"))
(let (quoted point beg end leading-space bolp fill-paragraph-function)
@@ -3617,7 +3620,7 @@ Prefix arg means justify as well."
"Message specific function to fill a paragraph.
This function is used as the value of `fill-paragraph-function' in
Message buffers and is not meant to be called directly."
- (interactive (list (if current-prefix-arg 'full)))
+ (interactive (list (if current-prefix-arg 'full)) message-mode)
(if (message-point-in-header-p)
(message-fill-field)
(message-newline-and-reformat arg t))
@@ -3648,7 +3651,7 @@ more information.
If FORCE is 0 (or when called interactively), the global values
of the signature variables will be consulted if the local ones
are null."
- (interactive (list 0))
+ (interactive (list 0) message-mode)
(let ((message-signature message-signature)
(message-signature-file message-signature-file))
;; If called interactively and there's no signature to insert,
@@ -3707,7 +3710,7 @@ are null."
(defun message-insert-importance-high ()
"Insert header to mark message as important."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3717,7 +3720,7 @@ are null."
(defun message-insert-importance-low ()
"Insert header to mark message as unimportant."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3729,7 +3732,7 @@ are null."
"Insert a \"Importance: high\" header, or cycle through the header values.
The three allowed values according to RFC 1327 are `high', `normal'
and `low'."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(let ((new "high")
cur)
@@ -3749,7 +3752,7 @@ and `low'."
(defun message-insert-disposition-notification-to ()
"Request a disposition notification (return receipt) to this message.
Note that this should not be used in newsgroups."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3764,7 +3767,7 @@ Note that this should not be used in newsgroups."
"Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
- (interactive "r")
+ (interactive "r" message-mode)
(let ((lines (count-lines b e))
(chars (- e b)))
(kill-region b e)
@@ -3781,7 +3784,8 @@ text was killed."
(min (point) (or (mark t) (point)))
(max (point) (or (mark t) (point)))
(when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
+ (prefix-numeric-value current-prefix-arg)))
+ message-mode)
(setq n (if (numberp n) (mod n 26) 13)) ;canonize N
(unless (or (zerop n) ; no action needed for a rot of 0
@@ -3815,7 +3819,8 @@ With prefix arg, specifies the number of places to rotate
each letter forward.
Mail and USENET news headers are not rotated unless WIDE is non-nil."
(interactive (if current-prefix-arg
(list (prefix-numeric-value current-prefix-arg))
- (list nil)))
+ (list nil))
+ message-mode)
(save-excursion
(save-restriction
(when (and (not wide) (message-goto-body))
@@ -3835,7 +3840,7 @@ Mail and USENET news headers are not rotated unless WIDE
is non-nil."
"Rename the *message* buffer to \"*message* RECIPIENT\".
If the function is run with a prefix, it will ask for a new buffer
name, rather than giving an automatic name."
- (interactive "Pbuffer name: ")
+ (interactive "Pbuffer name: " message-mode)
(save-excursion
(save-restriction
(goto-char (point-min))
@@ -3858,7 +3863,7 @@ name, rather than giving an automatic name."
(defun message-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
Numeric argument means justify as well."
- (interactive "P")
+ (interactive "P" message-mode)
(save-excursion
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t)
@@ -3923,7 +3928,7 @@ If REMOVE is non-nil, remove newlines, too.
To use this automatically, you may add this function to
`gnus-message-setup-hook'."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((citexp (concat "^\\("
(concat message-yank-cited-prefix "\\|")
message-yank-prefix
@@ -3988,7 +3993,7 @@ This function uses `message-cite-function' to do the
actual citing.
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
- (interactive "P")
+ (interactive "P" message-mode)
;; eval the let forms contained in message-cite-style
(let ((bindings (if (symbolp message-cite-style)
(symbol-value message-cite-style)
@@ -3999,7 +4004,7 @@ prefix, and don't delete any headers."
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
- (interactive "bYank buffer: ")
+ (interactive "bYank buffer: " message-mode)
(let ((message-reply-buffer (get-buffer buffer)))
(save-window-excursion
(message-yank-original))))
@@ -4226,7 +4231,7 @@ This function strips off the signature from the original
message."
"Send message like `message-send', then, if no errors, exit from mail buffer.
The usage of ARG is defined by the instance that called Message.
It should typically alter the sending method in some way or other."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((buf (current-buffer))
(position (point-marker))
(actions message-exit-actions))
@@ -4246,7 +4251,7 @@ It should typically alter the sending method in some way
or other."
(defun message-dont-send ()
"Don't send the message you have been editing.
Instead, just auto-save the buffer and then bury it."
- (interactive)
+ (interactive nil message-mode)
(set-buffer-modified-p t)
(save-buffer)
(let ((actions message-postpone-actions))
@@ -4255,7 +4260,7 @@ Instead, just auto-save the buffer and then bury it."
(defun message-kill-buffer ()
"Kill the current buffer."
- (interactive)
+ (interactive nil message-mode)
(when (or (not (buffer-modified-p))
(not message-kill-buffer-query)
(yes-or-no-p "Message modified; kill anyway? "))
@@ -4304,7 +4309,7 @@ Otherwise any failure is reported in a message back to
the user from
the mailer.
The usage of ARG is defined by the instance that called Message.
It should typically alter the sending method in some way or other."
- (interactive "P")
+ (interactive "P" message-mode)
;; Make it possible to undo the coming changes.
(undo-boundary)
(let ((inhibit-read-only t))
@@ -4572,7 +4577,7 @@ An address might be bogus if there's a matching entry in
"Warn before composing or sending a mail to an invalid address.
This function could be useful in `message-setup-hook'."
- (interactive)
+ (interactive nil message-mode)
(save-restriction
(message-narrow-to-headers)
(dolist (hdr '("To" "Cc" "Bcc"))
@@ -5744,7 +5749,7 @@ If NOW, use that time instead."
(defun message-insert-expires (days)
"Insert the Expires header. Expiry in DAYS days."
- (interactive "NExpire article in how many days? ")
+ (interactive "NExpire article in how many days? " message-mode)
(save-excursion
(message-position-on-field "Expires" "X-Draft-From")
(insert (message-make-expires-date days))))
@@ -6047,7 +6052,7 @@ give as trustworthy answer as possible."
(defun message-to-list-only ()
"Send a message to the list only.
Remove all addresses but the list address from To and Cc headers."
- (interactive)
+ (interactive nil message-mode)
(let ((listaddr (message-make-mail-followup-to t)))
(when listaddr
(save-excursion
@@ -6133,7 +6138,7 @@ subscribed address (and not the additional To and Cc
header contents)."
(defun message-idna-to-ascii-rhs ()
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
See `message-idna-encode'."
- (interactive)
+ (interactive nil message-mode)
(when message-use-idna
(save-excursion
(save-restriction
@@ -6351,7 +6356,7 @@ Headers already prepared in the buffer are not modified."
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
- (interactive "*")
+ (interactive "*" message-mode)
(split-line message-yank-prefix))
(defun message-insert-header (header value)
@@ -6549,7 +6554,7 @@ When called without a prefix argument, header value
spanning
multiple lines is treated as a single line. Otherwise, even if
N is 1, when point is on a continuation header line, it will be
moved to the beginning "
- (interactive "^p")
+ (interactive "^p" message-mode)
(cond
;; Go to beginning of header or beginning of line.
((and message-beginning-of-line (message-point-in-header-p))
@@ -6874,7 +6879,7 @@ are not included."
(defun message-insert-headers ()
"Generate the headers for the article."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -8214,7 +8219,7 @@ If nil, the function bound in `text-mode-map' or
`global-map' is executed."
Execute function specified by `message-tab-body-function' when
not in those headers. If that variable is nil, indent with the
regular text mode tabbing command."
- (interactive)
+ (interactive nil message-mode)
(cond
((let ((completion-fail-discreetly t))
(completion-at-point))
@@ -8591,7 +8596,7 @@ From headers in the original article."
(defun message-display-abbrev (&optional choose)
"Display the next possible abbrev for the text before point."
- (interactive (list t))
+ (interactive (list t) message-mode)
(when (message--in-tocc-p)
(let* ((end (point))
(start (save-excursion
@@ -8678,7 +8683,7 @@ Unless FORCE, prompt before sending.
The messages are separated by `message-form-letter-separator'.
Header and body are separated by `mail-header-separator'."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((sent 0) (skipped 0)
start end text
buff
@@ -8746,7 +8751,7 @@ Used in `message-simplify-recipients'."
(make-obsolete 'message-simplify-recipients nil "27.1")
(defun message-simplify-recipients ()
- (interactive)
+ (interactive nil message-mode)
(dolist (hdr '("Cc" "To"))
(message-replace-header
hdr
@@ -8769,7 +8774,8 @@ Used in `message-simplify-recipients'."
(defun message-make-html-message-with-image-files (files)
"Make a message containing the current dired-marked image files."
- (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+ (interactive (list (dired-get-marked-files nil current-prefix-arg))
+ dired-mode)
(message-mail)
(message-goto-body)
(insert "<#part type=text/html>\n\n")
@@ -8780,7 +8786,7 @@ Used in `message-simplify-recipients'."
(defun message-toggle-image-thumbnails ()
"For any included image files, insert a thumbnail of that image."
- (interactive)
+ (interactive nil message-mode)
(let ((displayed nil))
(save-excursion
(goto-char (point-min))
@@ -8816,7 +8822,7 @@ starting the screenshotting process.
The `message-screenshot-command' variable says what command is
used to take the screenshot."
- (interactive "p")
+ (interactive "p" message-mode)
(unless (executable-find (car message-screenshot-command))
(error "Can't find %s to take the screenshot"
(car message-screenshot-command)))
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index d41c9dd..a32eed4 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -250,7 +250,7 @@ You can also customize or set `mml-signencrypt-style-alist'
instead."
"Add MML tags to sign this MML part.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part
(or method mml-secure-method mml-default-sign-method)
'sign))
@@ -259,43 +259,43 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tags to encrypt this MML part.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part
(or method mml-secure-method mml-default-sign-method)))
(defun mml-secure-sign-pgp ()
"Add MML tags to PGP sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgp" 'sign))
(defun mml-secure-sign-pgpauto ()
"Add MML tags to PGP-auto sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpauto" 'sign))
(defun mml-secure-sign-pgpmime ()
"Add MML tags to PGP/MIME sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpmime" 'sign))
(defun mml-secure-sign-smime ()
"Add MML tags to S/MIME sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "smime" 'sign))
(defun mml-secure-encrypt-pgp ()
"Add MML tags to PGP encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgp"))
(defun mml-secure-encrypt-pgpmime ()
"Add MML tags to PGP/MIME encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpmime"))
(defun mml-secure-encrypt-smime ()
"Add MML tags to S/MIME encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "smime"))
(defun mml-secure-is-encrypted-p (&optional tag-present)
@@ -358,7 +358,7 @@ either an error is raised or not."
(defun mml-unsecure-message ()
"Remove security related MML tags from message."
- (interactive)
+ (interactive nil mml-mode)
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^<#secure.*>\n" nil t)
@@ -369,7 +369,7 @@ either an error is raised or not."
"Add MML tags to sign the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'sign))
@@ -378,7 +378,7 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tag to sign and encrypt the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'signencrypt))
@@ -387,53 +387,53 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tag to encrypt the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'encrypt))
(defun mml-secure-message-sign-smime ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "smime" 'sign))
(defun mml-secure-message-sign-pgp ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgp" 'sign))
(defun mml-secure-message-sign-pgpmime ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgpmime" 'sign))
(defun mml-secure-message-sign-pgpauto ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgpauto" 'sign))
(defun mml-secure-message-encrypt-smime (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgp (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgpmime (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgpauto (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index f77e5c6..dcc9ea5 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1339,7 +1339,7 @@ If not set, `default-directory' will be used."
(defun mml-quote-region (beg end)
"Quote the MML tags in the region."
- (interactive "r")
+ (interactive "r" mml-mode)
(save-excursion
(save-restriction
;; Temporarily narrow the region to defend from changes
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 76a7e21..56ca2e1 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,3 +1,4 @@
+
;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index d3ed360..5140861 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -83,12 +83,12 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
- (interactive)
+ (interactive nil gnus-score-mode)
(princ (time-to-days nil) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
- (interactive)
+ (interactive nil gnus-score-mode)
(goto-char (point-min))
(let ((form (read (current-buffer))))
(erase-buffer)
@@ -98,7 +98,7 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-exit ()
"Stop editing the score file."
- (interactive)
+ (interactive nil gnus-score-mode)
(unless (file-exists-p (file-name-directory (buffer-file-name)))
(make-directory (file-name-directory (buffer-file-name)) t))
(let ((coding-system-for-write score-mode-coding-system))
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 3ee5947..32283af 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -242,7 +242,7 @@ interactively. If there's no argument, do it at the
current buffer."
(defun smiley-toggle-buffer (&optional arg)
"Toggle displaying smiley faces in article buffer.
With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (if (numberp arg)
(> arg 0)
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 8900be5..2446577 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -672,7 +672,7 @@ The following commands are available:
(defun smime-exit ()
"Quit the S/MIME buffer."
- (interactive)
+ (interactive nil smime-mode)
(kill-buffer (current-buffer)))
;; Other functions
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index d87a6c2..7d93f8a 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -120,7 +120,8 @@ submitted at once. Internal variable.")
(defun spam-report-gmane-ham (&rest articles)
"Report ARTICLES as ham (unregister) through Gmane."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-summary-mode)
(let ((count 0))
(dolist (article articles)
(setq count (1+ count))
@@ -130,7 +131,8 @@ submitted at once. Internal variable.")
(defun spam-report-gmane-spam (&rest articles)
"Report ARTICLES as spam through Gmane."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-summary-mode)
(let ((count 0))
(dolist (article articles)
(setq count (1+ count))
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 70753ca..3e804ec 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -575,7 +575,6 @@ check the variable `spam-stat-score-data'."
(defun spam-stat-count ()
"Return size of `spam-stat'."
- (interactive)
(hash-table-count spam-stat))
(defun spam-stat-test-directory (dir &optional verbose)
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index f7288c9..d00f0a6 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1604,7 +1604,6 @@ parameters. A string as a parameter will set the
`spam-split-group' to that string.
See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (interactive)
(setq spam-split-last-successful-check nil)
(unless spam-split-disabled
(let ((spam-split-group-choice spam-split-group))
@@ -1654,7 +1653,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(defun spam-find-spam ()
"Detect spam in the current newsgroup using `spam-split'."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((group gnus-newsgroup-name)
(autodetect (gnus-parameter-spam-autodetect group))
@@ -2434,7 +2433,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-bogofilter-score (&optional recheck)
"Get the Bogofilter spamicity score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2606,7 +2605,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-spamassassin-score (&optional recheck)
"Get the SpamAssassin score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2673,7 +2672,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-bsfilter-score (&optional recheck)
"Get the Bsfilter spamicity score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2759,7 +2758,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-crm114-score ()
"Get the CRM114 Mailfilter pR."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index ddbd11f..407fb96 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1745,7 +1745,7 @@ documentation for the major and minor modes of that
buffer."
;; don't switch buffers before calling `help-buffer'.
(with-help-window (help-buffer)
(with-current-buffer buffer
- (let (minor-modes)
+ (let (minors)
;; Older packages do not register in minor-mode-list but only in
;; minor-mode-alist.
(dolist (x minor-mode-alist)
@@ -1768,19 +1768,19 @@ documentation for the major and minor modes of that
buffer."
fmode)))
(push (list fmode pretty-minor-mode
(format-mode-line (assq mode minor-mode-alist)))
- minor-modes)))))
+ minors)))))
;; Narrowing is not a minor mode, but its indicator is part of
;; mode-line-modes.
(when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
- (setq minor-modes
- (sort minor-modes
+ (push '(narrow-to-region "Narrow" " Narrow") minors))
+ (setq minors
+ (sort minors
(lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minor-modes
+ (when minors
(princ "Enabled minor modes:\n")
(make-local-variable 'help-button-cache)
(with-current-buffer standard-output
- (dolist (mode minor-modes)
+ (dolist (mode minors)
(let ((mode-function (nth 0 mode))
(pretty-minor-mode (nth 1 mode))
(indicator (nth 2 mode)))
@@ -1829,9 +1829,30 @@ documentation for the major and minor modes of that
buffer."
nil t)
(help-xref-button 1 'help-function-def mode file-name)))))
(princ ":\n")
- (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
+ (princ (help-split-fundoc (documentation major-mode) nil 'doc))
+ (princ (help-fns--list-local-commands)))))
;; For the sake of IELM and maybe others
nil)
+
+(defun help-fns--list-local-commands ()
+ (let ((functions nil))
+ (mapatoms
+ (lambda (sym)
+ (when (and (commandp sym)
+ ;; Ignore aliases.
+ (not (symbolp (symbol-function sym)))
+ ;; Ignore everything bound.
+ (not (where-is-internal sym))
+ (apply #'derived-mode-p (command-modes sym)))
+ (push sym functions))))
+ (with-temp-buffer
+ (when functions
+ (setq functions (sort functions #'string<))
+ (insert "\n\nOther commands for this mode, not bound to any keys:\n\n")
+ (dolist (function functions)
+ (insert (format "`%s'\n" function))))
+ (buffer-string))))
+
;; Widgets.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 9ed295e..ec0a559 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -985,7 +985,13 @@ Otherwise, display the image by calling `image-mode'."
(edges (window-inside-pixel-edges window))
(window-width (- (nth 2 edges) (nth 0 edges)))
(window-height (- (nth 3 edges) (nth 1 edges))))
+ ;; If the size has been changed manually (with `+'/`-'),
+ ;; then :max-width/:max-height is nil. In that case, do
+ ;; no automatic resizing.
(when (and image-width image-height
+ ;; Don't do resizing if we have a manual
+ ;; rotation (from the `r' command), either.
+ (not (plist-get (cdr spec) :rotation))
(or (not (= image-width window-width))
(not (= image-height window-height))))
(unless image-fit-to-window-lock
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 2dc9419..c2cf234 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -118,8 +118,9 @@ If the data is invalid, an `exif-error' is signaled."
dest))
(when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
(exif--parse-exif-chunk app1))))
- (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
- (exif--parse-exif-chunk app1)))))
+ (save-excursion
+ (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
+ (exif--parse-exif-chunk app1))))))
(defun exif-orientation (exif)
"Return the orientation (in degrees) in EXIF.
diff --git a/lisp/info.el b/lisp/info.el
index 7f169f4..e7324ef 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1972,7 +1972,8 @@ If DIRECTION is `backward', search in the reverse
direction."
(format-prompt
"Regexp search%s" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
- nil 'Info-search-history)))
+ nil 'Info-search-history))
+ Info-mode)
(when (equal regexp "")
(setq regexp (car Info-search-history)))
(when regexp
@@ -2080,13 +2081,13 @@ If DIRECTION is `backward', search in the reverse
direction."
(defun Info-search-case-sensitively ()
"Search for a regexp case-sensitively."
- (interactive)
+ (interactive nil Info-mode)
(let ((case-fold-search nil))
(call-interactively 'Info-search)))
(defun Info-search-next ()
"Search for next regexp from a previous `Info-search' command."
- (interactive)
+ (interactive nil Info-mode)
(let ((case-fold-search Info-search-case-fold))
(if Info-search-history
(Info-search (car Info-search-history))
@@ -2098,7 +2099,8 @@ If DIRECTION is `backward', search in the reverse
direction."
(format-prompt
"Regexp search%s backward" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
- nil 'Info-search-history)))
+ nil 'Info-search-history))
+ Info-mode)
(Info-search regexp bound noerror count 'backward))
(defun Info-isearch-search ()
@@ -2235,7 +2237,7 @@ End of submatch 0, 1, and 3 are the same, so you can
safely concat."
(defun Info-next ()
"Go to the \"next\" node, staying on the same hierarchical level.
This command doesn't descend into sub-nodes, like
\\<Info-mode-map>\\[Info-forward-node] does."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2244,7 +2246,7 @@ This command doesn't descend into sub-nodes, like
\\<Info-mode-map>\\[Info-forwa
(defun Info-prev ()
"Go to the \"previous\" node, staying on the same hierarchical level.
This command doesn't go up to the parent node, like
\\<Info-mode-map>\\[Info-backward-node] does."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2253,7 +2255,7 @@ This command doesn't go up to the parent node, like
\\<Info-mode-map>\\[Info-bac
(defun Info-up (&optional same-file)
"Go to the superior node of this node.
If SAME-FILE is non-nil, do not move to a different Info file."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2284,7 +2286,7 @@ If SAME-FILE is non-nil, do not move to a different Info
file."
(defun Info-history-back ()
"Go back in the history to the last node visited."
- (interactive)
+ (interactive nil Info-mode)
(or Info-history
(user-error "This is the first Info node you looked at"))
(let ((history-forward
@@ -2304,7 +2306,7 @@ If SAME-FILE is non-nil, do not move to a different Info
file."
(defun Info-history-forward ()
"Go forward in the history of visited nodes."
- (interactive)
+ (interactive nil Info-mode)
(or Info-history-forward
(user-error "This is the last Info node you looked at"))
(let ((history-forward (cdr Info-history-forward))
@@ -2378,7 +2380,7 @@ If SAME-FILE is non-nil, do not move to a different Info
file."
(defun Info-history ()
"Go to a node with a menu of visited nodes."
- (interactive)
+ (interactive nil Info-mode)
(Info-find-node "*History*" "Top")
(Info-next-reference)
(Info-next-reference))
@@ -2415,7 +2417,7 @@ If SAME-FILE is non-nil, do not move to a different Info
file."
(defun Info-toc ()
"Go to a node with table of contents of the current Info file.
Table of contents is created from the tree structure of menus."
- (interactive)
+ (interactive nil Info-mode)
(Info-find-node Info-current-file "*TOC*")
(let ((prev-node (nth 1 (car Info-history))) p)
(goto-char (point-min))
@@ -2587,7 +2589,8 @@ new buffer."
(list (if (equal input "")
default input)
current-prefix-arg))
- (user-error "No cross-references in this node"))))
+ (user-error "No cross-references in this node")))
+ Info-mode)
(unless footnotename
(error "No reference was specified"))
@@ -2789,7 +2792,8 @@ new buffer."
(completing-read (format-prompt "Menu item" default)
#'Info-complete-menu-item nil t nil nil
default))))
- (list item current-prefix-arg))))
+ (list item current-prefix-arg)))
+ Info-mode)
;; there is a problem here in that if several menu items have the same
;; name you can only go to the node of the first with this command.
(Info-goto-node (Info-extract-menu-item menu-item)
@@ -2833,19 +2837,19 @@ new buffer."
(defun Info-nth-menu-item ()
"Go to the node of the Nth menu item.
N is the digit argument used to invoke this command."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node
(Info-extract-menu-counting
(- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
(defun Info-top-node ()
"Go to the Top node of this file."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node "Top"))
(defun Info-final-node ()
"Go to the final node in this file."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node "Top")
(let ((Info-history nil)
(case-fold-search t))
@@ -2869,7 +2873,7 @@ to the parent node.
When called from Lisp, NOT-DOWN non-nil means don't descend into sub-nodes,
NOT-UP non-nil means don't go to parent nodes, and NO-ERROR non-nil means
don't signal a user-error if there's no node to go to."
- (interactive)
+ (interactive nil Info-mode)
(goto-char (point-min))
(forward-line 1)
(let ((case-fold-search t))
@@ -2906,7 +2910,7 @@ don't signal a user-error if there's no node to go to."
"Go backward one node, considering all nodes as forming one sequence.
If the current node has a \"previous\" node, go to it, descending into its
last sub-node, if any; otherwise go \"up\" to the parent node."
- (interactive)
+ (interactive nil Info-mode)
(let ((prevnode (Info-extract-pointer "prev[ious]*" t))
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
@@ -2935,7 +2939,7 @@ last sub-node, if any; otherwise go \"up\" to the parent
node."
(defun Info-next-menu-item ()
"Go to the node of the next menu item."
- (interactive)
+ (interactive nil Info-mode)
;; Bind this in case the user sets it to nil.
(let* ((case-fold-search t)
(node
@@ -2949,7 +2953,7 @@ last sub-node, if any; otherwise go \"up\" to the parent
node."
(defun Info-last-menu-item ()
"Go to the node of the previous menu item."
- (interactive)
+ (interactive nil Info-mode)
(save-excursion
(forward-line 1)
;; Bind this in case the user sets it to nil.
@@ -2968,7 +2972,7 @@ last sub-node, if any; otherwise go \"up\" to the parent
node."
(defun Info-next-preorder ()
"Go to the next subnode or the next node, or go up a level."
- (interactive)
+ (interactive nil Info-mode)
(cond ((Info-no-error (Info-next-menu-item)))
((Info-no-error (Info-next)))
((Info-no-error (Info-up t))
@@ -2987,7 +2991,7 @@ last sub-node, if any; otherwise go \"up\" to the parent
node."
(defun Info-last-preorder ()
"Go to the last node, popping up a level if there is none."
- (interactive)
+ (interactive nil Info-mode)
(cond ((and Info-scroll-prefer-subnodes
(Info-no-error
(Info-last-menu-item)
@@ -3039,7 +3043,7 @@ the menu of a node, it moves to subnode indicated by the
following menu
item. (That case won't normally result from this command, but can happen
in other ways.)"
- (interactive)
+ (interactive nil Info-mode)
(if (or (< (window-start) (point-min))
(> (window-start) (point-max)))
(set-window-start (selected-window) (point)))
@@ -3061,7 +3065,7 @@ in other ways.)"
(defun Info-mouse-scroll-up (e)
"Scroll one screenful forward in Info, using the mouse.
See `Info-scroll-up'."
- (interactive "e")
+ (interactive "e" Info-mode)
(save-selected-window
(if (eventp e)
(select-window (posn-window (event-start e))))
@@ -3073,7 +3077,7 @@ If point is within the menu of a node, and
`Info-scroll-prefer-subnodes'
is non-nil, this goes to its last subnode. When you scroll past the
beginning of a node, that goes to the previous node or back up to the
parent node."
- (interactive)
+ (interactive nil Info-mode)
(if (or (< (window-start) (point-min))
(> (window-start) (point-max)))
(set-window-start (selected-window) (point)))
@@ -3093,7 +3097,7 @@ parent node."
(defun Info-mouse-scroll-down (e)
"Scroll one screenful backward in Info, using the mouse.
See `Info-scroll-down'."
- (interactive "e")
+ (interactive "e" Info-mode)
(save-selected-window
(if (eventp e)
(select-window (posn-window (event-start e))))
@@ -3139,7 +3143,7 @@ Return the new position of point, or nil."
"Move cursor to the next cross-reference or menu item in the node.
If COUNT is non-nil (interactively with a prefix arg), jump over
COUNT cross-references."
- (interactive "i\np")
+ (interactive "i\np" Info-mode)
(unless count
(setq count 1))
(if (< count 0)
@@ -3167,7 +3171,7 @@ COUNT cross-references."
"Move cursor to the previous cross-reference or menu item in the node.
If COUNT is non-nil (interactively with a prefix arg), jump over
COUNT cross-references."
- (interactive "i\np")
+ (interactive "i\np" Info-mode)
(unless count
(setq count 1))
(if (< count 0)
@@ -3365,7 +3369,7 @@ Give an empty topic name to go to the Index node itself."
(defun Info-index-next (num)
"Go to the next matching index item from the last
\\<Info-mode-map>\\[Info-index] command."
- (interactive "p")
+ (interactive "p" Info-mode)
(or Info-index-alternatives
(user-error "No previous `i' command"))
(while (< num 0)
@@ -3487,7 +3491,8 @@ search results."
(with-current-buffer Info-complete-menu-buffer
(Info-goto-index)
(completing-read "Index topic: " #'Info-complete-menu-item))
- (kill-buffer Info-complete-menu-buffer)))))
+ (kill-buffer Info-complete-menu-buffer))))
+ Info-mode)
(if (equal topic "")
(Info-find-node Info-current-file "*Index*")
(unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes)
@@ -3793,7 +3798,7 @@ with a list of packages that contain all specified
keywords."
(defun Info-undefined ()
"Make command be undefined in Info."
- (interactive)
+ (interactive nil Info-mode)
(ding))
(defun Info-help ()
@@ -3870,7 +3875,7 @@ ERRORSTRING optional fourth argument, controls action on
no match:
"\\<Info-mode-map>Follow a node reference near point.
Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or
\\[Info-up] command, depending on where you click.
At end of the node's text, moves to the next node, or up if none."
- (interactive "e")
+ (interactive "e" Info-mode)
(mouse-set-point click)
(and (not (Info-follow-nearest-node))
(save-excursion (forward-line 1) (eobp))
@@ -3884,7 +3889,7 @@ if point is in a menu item description, follow that menu
item.
If FORK is non-nil (interactively with a prefix arg), show the node in
a new Info buffer.
If FORK is a string, it is the name to use for the new buffer."
- (interactive "P")
+ (interactive "P" Info-mode)
(or (Info-try-follow-nearest-node fork)
(when (save-excursion
(search-backward "\n* menu:" nil t))
@@ -3954,7 +3959,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-mouse-follow-link (click)
"Follow a link where you click."
- (interactive "@e")
+ (interactive "@e" Info-mode)
(let* ((position (event-start click))
(posn-string (and position (posn-string position)))
(link-args (if posn-string
@@ -4158,12 +4163,12 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-history-back-menu (e)
"Pop up the menu with a list of previously visited Info nodes."
- (interactive "e")
+ (interactive "e" Info-mode)
(Info-history-menu e "Back in history" Info-history 'Info-history-back))
(defun Info-history-forward-menu (e)
"Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
- (interactive "e")
+ (interactive "e" Info-mode)
(Info-history-menu e "Forward in history" Info-history-forward
'Info-history-forward))
(defvar Info-menu-last-node nil)
@@ -4237,7 +4242,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
"Put the name of the current Info node into the kill ring.
The name of the Info file is prepended to the node name in parentheses.
With a zero prefix arg, put the name inside a function call to `info'."
- (interactive "P")
+ (interactive "P" Info-mode)
(unless Info-current-node
(user-error "No current Info node"))
(let ((node (if (stringp Info-current-file)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index b58ca8a..c571ea9 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -4127,13 +4127,13 @@ Attempt to do the search exactly the way the pending
Isearch would."
"Update highlighting of other matches in the full buffer."
(let ((max lazy-highlight-buffer-max-at-a-time)
(looping t)
- nomore window-start window-end
- (opoint (point)))
+ nomore opoint window-start window-end)
(with-local-quit
(save-selected-window
(if (and (window-live-p isearch-lazy-highlight-window)
(not (memq (selected-window)
isearch-lazy-highlight-window-group)))
(select-window isearch-lazy-highlight-window))
+ (setq opoint (point))
(setq window-start (window-group-start))
(setq window-end (window-group-end))
(save-excursion
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index ca1aae7..c03e86b 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -1,4 +1,4 @@
-;;; hangul.el --- Korean Hangul input method
+;;; hangul.el --- Korean Hangul input method -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -88,9 +88,9 @@
(defvar hangul-im-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "\d" 'hangul-delete-backward-char)
- (define-key map [f9] 'hangul-to-hanja-conversion)
- (define-key map [Hangul_Hanja] 'hangul-to-hanja-conversion)
+ (define-key map "\d" #'hangul-delete-backward-char)
+ (define-key map [f9] #'hangul-to-hanja-conversion)
+ (define-key map [Hangul_Hanja] #'hangul-to-hanja-conversion)
map)
"Keymap for Hangul method. It is used by all Hangul input methods.")
@@ -337,7 +337,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
char)))))
(aset hangul-queue 5 char)))
(hangul-insert-character hangul-queue)
- (if (zerop (apply '+ (append hangul-queue nil)))
+ (if (zerop (apply #'+ (append hangul-queue nil)))
(hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
(hangul-insert-character hangul-queue
(setq hangul-queue (vector 0 0 0 0 char 0))))))
@@ -349,7 +349,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
(while (and (> i 0) (zerop (aref hangul-queue i)))
(setq i (1- i)))
(aset hangul-queue i 0))
- (if (notzerop (apply '+ (append hangul-queue nil)))
+ (if (notzerop (apply #'+ (append hangul-queue nil)))
(hangul-insert-character hangul-queue)
(delete-char -1)))
@@ -514,16 +514,16 @@ When a Korean input method is off, convert the following
hangul character."
(defvar-local hangul-input-method-help-text nil)
;;;###autoload
-(defun hangul-input-method-activate (input-method func help-text &rest args)
+(defun hangul-input-method-activate (_input-method func help-text &rest _args)
"Activate Hangul input method INPUT-METHOD.
FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'."
- (setq deactivate-current-input-method-function
'hangul-input-method-deactivate
- describe-current-input-method-function 'hangul-input-method-help
+ (setq deactivate-current-input-method-function
#'hangul-input-method-deactivate
+ describe-current-input-method-function #'hangul-input-method-help
hangul-input-method-help-text help-text)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
+ (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer))
(setq-local input-method-function func))
(defun hangul-input-method-deactivate ()
@@ -538,7 +538,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(define-obsolete-function-alias
'hangul-input-method-inactivate
- 'hangul-input-method-deactivate "24.3")
+ #'hangul-input-method-deactivate "24.3")
(defun hangul-input-method-help ()
"Describe the current Hangul input method."
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 6f5054e..2e36508 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -1,4 +1,4 @@
-;;; indian.el --- Quail packages for inputting Indian
+;;; indian.el --- Quail packages for inputting Indian -*- lexical-binding: t;
-*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -39,7 +39,7 @@
(defun quail-define-indian-trans-package (hashtbls pkgname
lang title doc)
- (funcall 'quail-define-package pkgname lang title t doc
+ (quail-define-package pkgname lang title t doc
nil nil nil nil nil nil t nil)
(maphash
(lambda (key val)
@@ -200,7 +200,7 @@
(setq clm 6)
(dolist (v vowels)
- (apply 'insert (propertize "\t" 'display (list 'space :align-to clm))
+ (apply #'insert (propertize "\t" 'display (list 'space :align-to clm))
(if (nth 1 c) (list (nth 1 c) (nth 2 v)) (list "")))
(setq clm (+ clm 6))))
(insert "\n")
@@ -309,7 +309,7 @@ Full key sequences are listed below:")
(defun quail-define-inscript-package (char-tables key-tables pkgname lang
title docstring)
- (funcall 'quail-define-package pkgname lang title nil docstring
+ (quail-define-package pkgname lang title nil docstring
nil nil nil t nil nil nil nil)
(let (char-table key-table char key)
(while (and char-tables key-tables)
@@ -627,7 +627,7 @@ Full key sequences are listed below:")
(quail-define-package "malayalam-mozhi" "Malayalam" "MlmMI" t
"Malayalam transliteration by Mozhi method."
nil nil t nil nil nil t nil
- 'indian-mlm-mozhi-update-translation)
+ #'indian-mlm-mozhi-update-translation)
(maphash
(lambda (key val)
@@ -636,9 +636,9 @@ Full key sequences are listed below:")
(vector val))))
(cdr indian-mlm-mozhi-hash))
-(defun indian-mlm-mozhi-underscore (key len) (throw 'quail-tag nil))
+(defun indian-mlm-mozhi-underscore (_key _len) (throw 'quail-tag nil))
-(quail-defrule "_" 'indian-mlm-mozhi-underscore)
+(quail-defrule "_" #'indian-mlm-mozhi-underscore)
(quail-defrule "|" ?)
(quail-defrule "||" ?)
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index d9f5888..e805c6a 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -1,4 +1,4 @@
-;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*-
+;;; ipa.el --- Quail package for inputting IPA characters -*-
lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -276,7 +276,7 @@ string."
(cl-assert (vectorp quail-keymap) t)
(setq quail-keymap (append quail-keymap nil))))
(list
- (apply 'vector
+ (apply #'vector
(mapcar
#'(lambda (entry)
(cl-assert (char-or-string-p entry) t)
@@ -502,9 +502,9 @@ of the mapping.")
;; diacritic. To avoid this, handle the input specially with the function
;; ipa-x-sampa-underscore-implosive.
-(dolist (implosive-x-sampa (mapcar 'car ipa-x-sampa-implosive-submap))
+(dolist (implosive-x-sampa (mapcar #'car ipa-x-sampa-implosive-submap))
(setq implosive-x-sampa (car (split-string implosive-x-sampa "_")))
(quail-defrule (format "%s_" implosive-x-sampa)
- 'ipa-x-sampa-underscore-implosive))
+ #'ipa-x-sampa-underscore-implosive))
;;; ipa.el ends here
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index a4ea550..6a2bcdc 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -1,4 +1,4 @@
-;;; japanese.el --- Quail package for inputting Japanese
+;;; japanese.el --- Quail package for inputting Japanese -*- lexical-binding:
t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -412,7 +412,7 @@ C-h kkc-help
List these key bindings.
"
nil t t nil nil nil nil nil
- 'quail-japanese-update-translation
+ #'quail-japanese-update-translation
'(("K" . quail-japanese-toggle-kana)
(" " . quail-japanese-kanji-kkc)
("\C-m" . quail-no-conversion)
@@ -491,7 +491,7 @@ qh: shift to the input method `japanese',
qq: toggle between this input method and the input method `japanese-ascii'.
"
nil t t nil nil nil nil nil
- 'quail-japanese-hankaku-update-translation)
+ #'quail-japanese-hankaku-update-translation)
(dolist (elt quail-japanese-transliteration-rules)
(quail-defrule (car elt)
@@ -517,7 +517,7 @@ qq: toggle between this input method and the input method
`japanese-ascii'.
nil
"Japanese hiragana input method by Roman transliteration."
nil t t nil nil nil nil nil
- 'quail-japanese-update-translation)
+ #'quail-japanese-update-translation)
;; Use the same map as that of `japanese'.
(setcar (cdr (cdr quail-current-package))
@@ -538,7 +538,7 @@ qq: toggle between this input method and the input method
`japanese-ascii'.
nil
"Japanese katakana input method by Roman transliteration."
nil t t nil nil nil nil nil
- 'quail-japanese-katakana-update-translation)
+ #'quail-japanese-katakana-update-translation)
(dolist (elt quail-japanese-transliteration-rules)
(quail-defrule (car elt)
diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el
index af3b589..a932460 100644
--- a/lisp/leim/quail/lao.el
+++ b/lisp/leim/quail/lao.el
@@ -1,4 +1,4 @@
-;;; lao.el --- Quail package for inputting Lao characters -*-coding: utf-8;-*-
+;;; lao.el --- Quail package for inputting Lao characters -*-
lexical-binding: t; -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
@@ -195,7 +195,7 @@ you need to re-load it to properly re-initialize related
alists.")
(quail-define-package
"lao" "Lao" "ລ" t
"Lao input method simulating Lao keyboard layout based on Thai TIS620"
- nil t t t t nil nil nil 'quail-lao-update-translation nil t)
+ nil t t t t nil nil nil #'quail-lao-update-translation nil t)
(quail-install-map
(quail-map-from-table
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index fd78253..8b1e520 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -1,4 +1,4 @@
-;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*-
+;;; latin-ltx.el --- Quail package for TeX-style input -*- lexical-binding: t;
-*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el
index e05bc1e..68eaeb5 100644
--- a/lisp/leim/quail/lrt.el
+++ b/lisp/leim/quail/lrt.el
@@ -1,4 +1,4 @@
-;;; lrt.el --- Quail package for inputting Lao characters by LRT method
-*-coding: utf-8;-*-
+;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-
lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -60,7 +60,7 @@
`\\' (backslash) + `$' => ຯ LAO ELLIPSIS
"
nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout
- nil nil nil 'quail-lrt-update-translation nil t)
+ nil nil nil #'quail-lrt-update-translation nil t)
;; LRT (Lao Roman Transcription) input method accepts the following
;; key sequence:
diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el
index 8e7a500..aa35bb0 100644
--- a/lisp/leim/quail/sisheng.el
+++ b/lisp/leim/quail/sisheng.el
@@ -1,4 +1,4 @@
-;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
+;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
-*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el
index 7cf11da..07ba657 100644
--- a/lisp/leim/quail/thai.el
+++ b/lisp/leim/quail/thai.el
@@ -1,4 +1,4 @@
-;;; thai.el --- Quail package for inputting Thai characters -*-coding:
utf-8;-*-
+;;; thai.el --- Quail package for inputting Thai characters -*-
lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index a54763d..33cc6f5 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -1,4 +1,4 @@
-;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding:
utf-8-emacs;-*-
+;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding:
utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -158,7 +158,7 @@
Tsheg is assigned to SPC. Space is assigned to period `.'.
"
nil nil nil nil nil nil nil nil
- 'quail-tibetan-update-translation)
+ #'quail-tibetan-update-translation)
;; Here we build up a Quail map for a Tibetan sequence the whole of
;; which can be one composition.
@@ -371,7 +371,7 @@
(setq trans-list (cons trans trans-list)
i last)
(setq trans-list nil i len))))
- (apply 'concat (nreverse trans-list))))
+ (apply #'concat (nreverse trans-list))))
(defvar quail-tibkey-characters nil)
@@ -440,7 +440,7 @@
I hope I'll complete in a future revision.
"
nil nil nil nil nil nil nil nil
- 'quail-tibkey-update-translation)
+ #'quail-tibkey-update-translation)
(quail-install-map
(quail-map-from-table
diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el
index c7cf6ab..bfe4ce6 100644
--- a/lisp/leim/quail/uni-input.el
+++ b/lisp/leim/quail/uni-input.el
@@ -1,4 +1,4 @@
-;;; uni-input.el --- Hex Unicode input method
+;;; uni-input.el --- Hex Unicode input method -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -57,11 +57,12 @@
(echo-keystrokes 0)
(help-char nil)
(events (list key))
- (str " "))
+ ;; (str " ")
+ )
(unwind-protect
(catch 'non-digit
(progn
- (dotimes (i 4)
+ (dotimes (_ 4)
(let ((seq (read-key-sequence nil))
key)
(if (and (stringp seq)
@@ -76,7 +77,7 @@
(throw 'non-digit (append (reverse events)
(listify-key-sequence seq))))))
(quail-delete-region)
- (let ((n (string-to-number (apply 'string
+ (let ((n (string-to-number (apply #'string
(cdr (nreverse events)))
16)))
(if (characterp n)
@@ -100,12 +101,12 @@ While this input method is active, the variable
(quail-delete-overlays)
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function))
- (setq deactivate-current-input-method-function 'ucs-input-deactivate)
- (setq describe-current-input-method-function 'ucs-input-help)
+ (setq deactivate-current-input-method-function #'ucs-input-deactivate)
+ (setq describe-current-input-method-function #'ucs-input-help)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (setq-local input-method-function 'ucs-input-method)))
+ (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer))
+ (setq-local input-method-function #'ucs-input-method)))
(defun ucs-input-deactivate ()
"Deactivate UCS input method."
@@ -114,7 +115,7 @@ While this input method is active, the variable
(define-obsolete-function-alias
'ucs-input-inactivate
- 'ucs-input-deactivate "24.3")
+ #'ucs-input-deactivate "24.3")
(defun ucs-input-help ()
(interactive)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index cafde7c..526f7c3 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -524,7 +524,8 @@ lost after dumping")))
(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(define-key global-map "\M-o" 'facemenu-keymap)
(define-key facemenu-keymap "\eS" 'center-paragraph)
- (define-key facemenu-keymap "\es" 'center-line))
+ (define-key facemenu-keymap "\es" 'center-line)
+ (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block))
(if dump-mode
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index a899a94..aacb8ab 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2116,18 +2116,19 @@ variables.")
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
- (when (or
- (innermost-minibuffer-p)
- (not (minibufferp)))
+ (when (minibufferp)
+ (when (not (minibuffer-innermost-command-loop-p))
+ (error "%s" "Not in most nested command loop"))
+ (when (not (innermost-minibuffer-p))
+ (error "%s" "Not in most nested minibuffer")))
;; If the command that uses this has made modifications in the minibuffer,
;; we don't want them to cause deactivation of the mark in the original
;; buffer.
;; A better solution would be to make deactivate-mark buffer-local
;; (or to turn it into a list of buffers, ...), but in the mean time,
;; this should do the trick in most cases.
- (setq deactivate-mark nil)
- (throw 'exit nil))
- (error "%s" "Not in most nested minibuffer"))
+ (setq deactivate-mark nil)
+ (throw 'exit nil))
(defun self-insert-and-exit ()
"Terminate minibuffer input."
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index e39a4c3..c94fa03 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -855,7 +855,7 @@ Currently this means either text/html or
application/xhtml+xml."
(defun eww-view-source ()
"View the HTML source code of the current page."
- (interactive)
+ (interactive nil eww-mode)
(let ((buf (get-buffer-create "*eww-source*"))
(source (plist-get eww-data :source)))
(with-current-buffer buf
@@ -881,7 +881,7 @@ Currently this means either text/html or
application/xhtml+xml."
(defun eww-toggle-paragraph-direction ()
"Cycle the paragraph direction between left-to-right, right-to-left and
auto."
- (interactive)
+ (interactive nil eww-mode)
(setq bidi-paragraph-direction
(cond ((eq bidi-paragraph-direction 'left-to-right)
nil)
@@ -899,7 +899,7 @@ Currently this means either text/html or
application/xhtml+xml."
This command uses heuristics to find the parts of the web page that
contains the main textual portion, leaving out navigation menus and
the like."
- (interactive)
+ (interactive nil eww-mode)
(let* ((old-data eww-data)
(dom (with-temp-buffer
(insert (plist-get old-data :source))
@@ -1038,6 +1038,7 @@ the like."
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web."
+ :interactive nil
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
@@ -1090,7 +1091,7 @@ instead of `browse-url-new-window-flag'."
(defun eww-back-url ()
"Go to the previously displayed page."
- (interactive)
+ (interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
(eww-save-history)
@@ -1099,7 +1100,7 @@ instead of `browse-url-new-window-flag'."
(defun eww-forward-url ()
"Go to the next displayed page."
- (interactive)
+ (interactive nil eww-mode)
(when (zerop eww-history-position)
(user-error "No next page"))
(eww-save-history)
@@ -1123,7 +1124,7 @@ instead of `browse-url-new-window-flag'."
"Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :next)
(eww-browse-url (shr-expand-url (plist-get eww-data :next)
(plist-get eww-data :url)))
@@ -1133,7 +1134,7 @@ or <a> tag."
"Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :previous)
(eww-browse-url (shr-expand-url (plist-get eww-data :previous)
(plist-get eww-data :url)))
@@ -1143,7 +1144,7 @@ or <a> tag."
"Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :up)
(eww-browse-url (shr-expand-url (plist-get eww-data :up)
(plist-get eww-data :url)))
@@ -1153,7 +1154,7 @@ or <a> tag."
"Go to the page marked `top'.
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(let ((best-url (or (plist-get eww-data :start)
(plist-get eww-data :contents)
(plist-get eww-data :home))))
@@ -1166,7 +1167,7 @@ appears in a <link> or <a> tag."
If LOCAL is non-nil (interactively, the command was invoked with
a prefix argument), don't reload the page from the network, but
just re-display the HTML already fetched."
- (interactive "P")
+ (interactive "P" eww-mode)
(let ((url (plist-get eww-data :url)))
(if local
(if (null (plist-get eww-data :dom))
@@ -1232,12 +1233,12 @@ just re-display the HTML already fetched."
(defun eww-beginning-of-text ()
"Move to the start of the input field."
- (interactive)
+ (interactive nil eww-mode)
(goto-char (eww-beginning-of-field)))
(defun eww-end-of-text ()
"Move to the end of the text in the input field."
- (interactive)
+ (interactive nil eww-mode)
(goto-char (eww-end-of-field))
(let ((start (eww-beginning-of-field)))
(while (and (equal (following-char) ? )
@@ -1329,7 +1330,7 @@ just re-display the HTML already fetched."
(defun eww-select-file ()
"Change the value of the upload file menu under point."
- (interactive)
+ (interactive nil eww-mode)
(let* ((input (get-text-property (point) 'eww-form)))
(let ((filename
(let ((insert-default-directory t))
@@ -1537,7 +1538,9 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
- (interactive (list last-nonmenu-event))
+ (interactive
+ (list last-nonmenu-event)
+ eww-mode)
(mouse-set-point event)
(let ((input (get-text-property (point) 'eww-form)))
(popup-menu
@@ -1572,7 +1575,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-toggle-checkbox ()
"Toggle the value of the checkbox under point."
- (interactive)
+ (interactive nil eww-mode)
(let* ((input (get-text-property (point) 'eww-form))
(type (plist-get input :type)))
(if (equal type "checkbox")
@@ -1642,7 +1645,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-submit ()
"Submit the current form."
- (interactive)
+ (interactive nil eww-mode)
(let* ((this-input (get-text-property (point) 'eww-form))
(form (plist-get this-input :eww-form))
values next-submit)
@@ -1729,7 +1732,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
"Browse the current URL with an external browser.
The browser to used is specified by the
`browse-url-secondary-browser-function' variable."
- (interactive)
+ (interactive nil eww-mode)
(funcall browse-url-secondary-browser-function
(or url (plist-get eww-data :url))))
@@ -1739,7 +1742,9 @@ If EXTERNAL is single prefix, browse the URL using
`browse-url-secondary-browser-function'.
If EXTERNAL is double prefix, browse in new buffer."
- (interactive (list current-prefix-arg last-nonmenu-event))
+ (interactive
+ (list current-prefix-arg last-nonmenu-event)
+ eww-mode)
(mouse-set-point mouse-event)
(let ((url (get-text-property (point) 'shr-url)))
(cond
@@ -1773,14 +1778,14 @@ Differences in #targets are ignored."
(defun eww-copy-page-url ()
"Copy the URL of the current page into the kill ring."
- (interactive)
+ (interactive nil eww-mode)
(message "%s" (plist-get eww-data :url))
(kill-new (plist-get eww-data :url)))
(defun eww-download ()
"Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
- (interactive)
+ (interactive nil eww-mode)
(let ((dir (if (stringp eww-download-directory)
eww-download-directory
(funcall eww-download-directory))))
@@ -1848,14 +1853,14 @@ Use link at point if there is one, else the current
page's URL."
(defun eww-set-character-encoding (charset)
"Set character encoding to CHARSET.
If CHARSET is nil then use UTF-8."
- (interactive "zUse character set (default utf-8): ")
+ (interactive "zUse character set (default utf-8): " eww-mode)
(if (null charset)
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
(defun eww-switch-to-buffer ()
"Prompt for an EWW buffer to display in the selected window."
- (interactive)
+ (interactive nil eww-mode)
(let ((completion-extra-properties
'(:annotation-function (lambda (buf)
(with-current-buffer buf
@@ -1873,7 +1878,7 @@ If CHARSET is nil then use UTF-8."
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
- (interactive)
+ (interactive nil eww-mode)
(setq shr-use-fonts (not shr-use-fonts))
(eww-reload)
(message "Proportional fonts are now %s"
@@ -1881,7 +1886,7 @@ If CHARSET is nil then use UTF-8."
(defun eww-toggle-colors ()
"Toggle whether to use HTML-specified colors or not."
- (interactive)
+ (interactive nil eww-mode)
(message "Colors are now %s"
(if (setq shr-use-colors (not shr-use-colors))
"on"
@@ -1894,7 +1899,7 @@ If CHARSET is nil then use UTF-8."
(defun eww-add-bookmark ()
"Bookmark the current page."
- (interactive)
+ (interactive nil eww-mode)
(eww-read-bookmarks)
(dolist (bookmark eww-bookmarks)
(when (equal (plist-get eww-data :url) (plist-get bookmark :url))
@@ -1958,7 +1963,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-bookmark-kill ()
"Kill the current bookmark."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let* ((start (line-beginning-position))
(bookmark (get-text-property start 'eww-bookmark))
(inhibit-read-only t))
@@ -1972,7 +1977,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-bookmark-yank ()
"Yank a previously killed bookmark to the current line."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(unless eww-bookmark-kill-ring
(user-error "No previously killed bookmark"))
(beginning-of-line)
@@ -1990,7 +1995,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-bookmark-browse ()
"Browse the bookmark under point in eww."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
(unless bookmark
(user-error "No bookmark on the current line"))
@@ -1999,7 +2004,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-next-bookmark ()
"Go to the next bookmark in the list."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
@@ -2018,7 +2023,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-previous-bookmark ()
"Go to the previous bookmark in the list."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
@@ -2061,6 +2066,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
"Mode for listing bookmarks.
\\{eww-bookmark-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
@@ -2109,7 +2115,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-history-browse ()
"Browse the history under point in eww."
- (interactive)
+ (interactive nil eww-history-mode)
(let ((history (get-text-property (line-beginning-position) 'eww-history)))
(unless history
(error "No history on the current line"))
@@ -2137,6 +2143,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
"Mode for listing eww-histories.
\\{eww-history-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
@@ -2191,7 +2198,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-buffer-select ()
"Switch to eww buffer."
- (interactive)
+ (interactive nil eww-buffers-mode)
(let ((buffer (get-text-property (line-beginning-position)
'eww-buffer)))
(unless buffer
@@ -2211,7 +2218,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-buffer-show-next ()
"Move to next eww buffer in the list and display it."
- (interactive)
+ (interactive nil eww-buffers-mode)
(forward-line)
(when (eobp)
(goto-char (point-min)))
@@ -2219,7 +2226,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-buffer-show-previous ()
"Move to previous eww buffer in the list and display it."
- (interactive)
+ (interactive nil eww-buffers-mode)
(beginning-of-line)
(when (bobp)
(goto-char (point-max)))
@@ -2228,7 +2235,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(defun eww-buffer-kill ()
"Kill buffer from eww list."
- (interactive)
+ (interactive nil eww-buffers-mode)
(let* ((start (line-beginning-position))
(buffer (get-text-property start 'eww-buffer))
(inhibit-read-only t))
@@ -2262,6 +2269,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
"Mode for listing buffers.
\\{eww-buffers-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 9c3740f..0e89999 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -434,6 +434,7 @@ Value is a pair of positions (START . END) if there is a
non-nil
(defun shr-show-alt-text ()
"Show the ALT text of the image under point."
+ (declare (completion (lambda (_ b) (command-completion-button-p 'shr b))))
(interactive)
(let ((text (get-text-property (point) 'shr-alt)))
(if (not text)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 097f25e..f0bbe31 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -465,7 +465,7 @@ For details, see `tramp-rename-files'."
;;;###tramp-autoload
(defun tramp-version (arg)
- "Print version number of tramp.el in minibuffer or current buffer."
+ "Print version number of tramp.el in echo area or current buffer."
(interactive "P")
(if arg (insert tramp-version) (message tramp-version)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e946d73..9d4e04c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1172,6 +1172,9 @@ file names."
;; There might be a double slash. Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 96f7d9a..a7f4c9b 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -53,7 +53,12 @@
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-rclone-method
- (tramp-mount-args nil)
+ ;; Be careful changing "--dir-cache-time", this could
+ ;; delay visibility of files. Since we use Tramp's
+ ;; internal cache for file attributes, there shouldn't
+ ;; be serious performance penalties when set to 0.
+ (tramp-mount-args
+ ("--no-unicode-normalization" "--dir-cache-time" "0s"))
(tramp-copyto-args nil)
(tramp-moveto-args nil)
(tramp-about-args ("--full"))))
@@ -247,24 +252,13 @@ file names."
"Error %s `%s' `%s'" msg-operation filename newname)))
(when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)
- (when (tramp-rclone-file-name-p filename)
- (tramp-rclone-flush-directory-cache v1)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (file-exists-p filename)
- (tramp-flush-file-properties v1 v1-localname)))))
+ (while (file-exists-p filename)
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname))))
(when t2
(with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)
- (when (tramp-rclone-file-name-p newname)
- (tramp-rclone-flush-directory-cache v2)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (not (file-exists-p newname))
- (tramp-flush-file-properties v2 v2-localname))))))))))
+ (tramp-flush-file-properties v2 v2-localname))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -288,13 +282,11 @@ file names."
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)
(delete-directory (tramp-rclone-local-file-name directory) recursive
trash)))
(defun tramp-rclone-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-rclone-flush-directory-cache v)
(delete-file (tramp-rclone-local-file-name filename) trash)
(tramp-flush-file-properties v localname)))
@@ -420,8 +412,7 @@ file names."
;; whole file cache.
(tramp-flush-file-properties v localname)
(tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (tramp-rclone-flush-directory-cache v)))
+ v (if parents "/" (file-name-directory localname)))))
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -467,39 +458,6 @@ file names."
mount)
(match-string 1 mount)))))))
-(defun tramp-rclone-flush-directory-cache (vec)
- "Flush directory cache of VEC mount."
- (let ((rclone-pid
- ;; Identify rclone process.
- (when (tramp-get-connection-process vec)
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "rclone-pid"
- (catch 'pid
- (dolist
- (pid
- ;; Until Emacs 25, `process-attributes' could
- ;; crash Emacs for some processes. So we use
- ;; "pidof", which might not work everywhere.
- (if (<= emacs-major-version 25)
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (mapcar
- #'string-to-number
- (split-string
- (shell-command-to-string "pidof rclone"))))
- (list-system-processes)))
- (and (string-match-p
- (regexp-quote
- (format "rclone mount %s:" (tramp-file-name-host vec)))
- (or (cdr (assoc 'args (process-attributes pid))) ""))
- (throw 'pid pid))))))))
- ;; Send a SIGHUP in order to flush directory cache.
- (when rclone-pid
- (tramp-message
- vec 6 "Send SIGHUP %d: %s"
- rclone-pid (cdr (assoc 'args (process-attributes rclone-pid))))
- (signal-process rclone-pid 'SIGHUP))))
-
(defun tramp-rclone-local-file-name (filename)
"Return local mount name of FILENAME."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
@@ -572,7 +530,7 @@ connection if a previous connection has died for some
reason."
`("mount" ,(concat host ":/")
,(tramp-rclone-mount-point vec)
;; This could be nil.
- ,(tramp-get-method-parameter vec 'tramp-mount-args))))
+ ,@(tramp-get-method-parameter vec 'tramp-mount-args))))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
@@ -607,9 +565,4 @@ The command is the list of strings ARGS."
(provide 'tramp-rclone)
-;;; TODO:
-
-;; * If possible, get rid of "rclone mount". Maybe it is more
-;; performant then.
-
;;; tramp-rclone.el ends here
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index bcdc014..5730199 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2818,6 +2818,9 @@ the result will be a local, non-Tramp, file name."
;; expands to "/". Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
@@ -2927,16 +2930,11 @@ alternative implementation will be used."
elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv)))))))
+ (setq uenv (cons elt uenv))))))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(command
(when (stringp program)
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
@@ -3147,14 +3145,8 @@ alternative implementation will be used."
(or (member elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv))))))
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
+ (setq uenv (cons elt uenv)))))
+ (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)
(when env
(setq command
(format
@@ -4307,10 +4299,9 @@ file exists and nonzero exit status otherwise."
(tramp-send-command
vec (format
(concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "exec env TERM='%s' INSIDE_EMACS='%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")
- tramp-terminal-type
- (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
+ tramp-terminal-type (tramp-inside-emacs)
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -5945,16 +5936,6 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
(delete-file tmpfile)))))
-(defun tramp-get-env-with-u-option (vec)
- "Check, whether the remote `env' command supports the -u option."
- (with-tramp-connection-property vec "env-u-option"
- (tramp-message vec 5 "Checking, whether `env -u' works")
- ;; Option "-u" is a GNU extension.
- (tramp-send-command-and-check
- vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
- (tramp-get-remote-null-device vec))
- t)))
-
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
"Return the compress command related to PROP.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 26ec910..4519c34 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -743,6 +743,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Make the file name absolute.
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0a60b79..e181365 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -364,6 +364,9 @@ the result will be a local, non-Tramp, file name."
(when (string-equal uname "~")
(setq uname (concat uname user)))
(setq localname (concat uname fname))))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
(tramp-make-tramp-file-name v (expand-file-name localname))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 690dd99..e99e439 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1750,7 +1750,7 @@ The outline level is equal to the verbosity of the Tramp
message."
(tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
(tramp-compat-temporary-file-directory)))
-(defsubst tramp-debug-message (vec fmt-string &rest arguments)
+(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
@@ -3163,6 +3163,9 @@ User is always nil."
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
;; be problems with UNC shares or Cygwin mounts.
@@ -3811,10 +3814,7 @@ It does not support `:stderr'."
elt (default-toplevel-value
'process-environment))))
(setq env (cons elt env)))))
(env (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep))
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(env (mapcar #'tramp-shell-quote-argument (delq nil env)))
;; Quote command.
(command (mapconcat #'tramp-shell-quote-argument command " "))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index ced3e93..abd9221 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -80,6 +80,11 @@
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
+(defun tramp-inside-emacs ()
+ "Version string provided by INSIDE_EMACS enmvironment variable."
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version))
+
;; Tramp versions integrated into Emacs. If a user option declares a
;; `:package-version' which doesn't belong to an integrated Tramp
;; version, it must be added here as well (see `tramp-syntax', for
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 18d4f3c..b14849d 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -44,7 +44,7 @@
BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-excursion' and
`save-match-data'."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
`(progn
(unless (org-babel-comint-buffer-livep ,buffer)
(error "Buffer %s does not exist or has no process" ,buffer))
@@ -53,7 +53,6 @@ executed inside the protection of `save-excursion' and
(save-excursion
(let ((comint-input-filter (lambda (_input) nil)))
,@body))))))
-(def-edebug-spec org-babel-comint-in-buffer (form body))
(defmacro org-babel-comint-with-output (meta &rest body)
"Evaluate BODY in BUFFER and return process output.
@@ -67,7 +66,7 @@ elements are optional.
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
- (declare (indent 1))
+ (declare (indent 1) (debug (sexp body)))
(let ((buffer (nth 0 meta))
(eoe-indicator (nth 1 meta))
(remove-echo (nth 2 meta))
@@ -112,7 +111,6 @@ or user `keyboard-quit' during execution of body."
string-buffer))
(setq string-buffer (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
-(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 1343410..b1fd694 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1100,7 +1100,7 @@ end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(let ((tempvar (make-symbol "file")))
`(let* ((case-fold-search t)
(,tempvar ,file)
@@ -1139,7 +1139,6 @@ end-body --------- point at the end of the body"
(goto-char end-block)))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
-(def-edebug-spec org-babel-map-src-blocks (form body))
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
@@ -1354,7 +1353,7 @@ the `org-mode-hook'."
(goto-char (match-beginning 0))
(org-babel-hide-hash)
(goto-char (match-end 0))))))
-(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
+(add-hook 'org-mode-hook #'org-babel-hide-all-hashes)
(defun org-babel-hash-at-point (&optional point)
"Return the value of the hash at POINT.
@@ -1372,7 +1371,7 @@ This can be called with `\\[org-ctrl-c-ctrl-c]'."
Add `org-babel-hide-result' as an invisibility spec for hiding
portions of results lines."
(add-to-invisibility-spec '(org-babel-hide-result . t)))
-(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
+(add-hook 'org-mode-hook #'org-babel-result-hide-spec)
(defvar org-babel-hide-result-overlays nil
"Overlays hiding results.")
@@ -1443,11 +1442,11 @@ portions of results lines."
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
+(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
- 'org-babel-show-result-all 'append 'local)))
+ #'org-babel-show-result-all 'append 'local)))
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
@@ -3075,8 +3074,7 @@ Emacs shutdown."))
(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
"Call the code to parse raw string results according to RESULT-PARAMS."
- (declare (indent 1)
- (debug (form form &rest form)))
+ (declare (indent 1) (debug t))
(org-with-gensyms (params)
`(let ((,params ,result-params))
(unless (member "none" ,params)
@@ -3093,7 +3091,6 @@ Emacs shutdown."))
(not (member "table" ,params))))
,scalar-form
,@table-forms)))))
-(def-edebug-spec org-babel-result-cond (form form body))
(defun org-babel-temp-file (prefix &optional suffix)
"Create a temporary file in the `org-babel-temporary-directory'.
@@ -3136,7 +3133,7 @@ of `org-babel-temporary-directory'."
org-babel-temporary-directory
"[directory not defined]"))))))
-(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory)
(defun org-babel-one-header-arg-safe-p (pair safe-list)
"Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 3c3943c..aa0373a 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -150,7 +150,7 @@ represented in the file."
"Open FILE into a temporary buffer execute BODY there like
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(let ((temp-path (make-symbol "temp-path"))
(temp-result (make-symbol "temp-result"))
(temp-file (make-symbol "temp-file"))
@@ -164,7 +164,6 @@ evaluating BODY."
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
,temp-result)))
-(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang-re)
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 99e5464..b9799d2 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -2090,6 +2090,7 @@ Note that functions in this alist don't need to be
quoted."
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
+ (declare (debug t))
(org-with-gensyms (marker)
`(let ((,marker (get-text-property (if ,string 0 (point-at-bol))
'org-hd-marker ,string)))
@@ -2097,7 +2098,6 @@ of the current line."
(save-excursion
(goto-char ,marker)
,@body)))))
-(def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 2073b33..2844b0e 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -911,17 +911,17 @@ If CLOCK-SOUND is non-nil, it overrides
`org-clock-sound'."
(defmacro org-with-clock-position (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock."
+ (declare (indent 1) (debug t))
`(with-current-buffer (marker-buffer (car ,clock))
(org-with-wide-buffer
(goto-char (car ,clock))
(beginning-of-line)
,@forms)))
-(def-edebug-spec org-with-clock-position (form body))
-(put 'org-with-clock-position 'lisp-indent-function 1)
(defmacro org-with-clock (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock.
This macro also protects the current active clock from being altered."
+ (declare (indent 1) (debug t))
`(org-with-clock-position ,clock
(let ((org-clock-start-time (cdr ,clock))
(org-clock-total-time)
@@ -932,8 +932,6 @@ This macro also protects the current active clock from
being altered."
(org-back-to-heading t)
(point-marker))))
,@forms)))
-(def-edebug-spec org-with-clock (form body))
-(put 'org-with-clock 'lisp-indent-function 1)
(defsubst org-clock-clock-in (clock &optional resume start-time)
"Clock in to the clock located by CLOCK.
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 29d9d58..d8a4937 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -239,11 +239,11 @@ When completing for #+STARTUP, for example, this function
returns
(require 'ox)
(pcomplete-here
(and org-export-exclude-tags
- (list (mapconcat 'identity org-export-exclude-tags " ")))))
+ (list (mapconcat #'identity org-export-exclude-tags " ")))))
(defun pcomplete/org-mode/file-option/filetags ()
"Complete arguments for the #+FILETAGS file option."
- (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))
+ (pcomplete-here (and org-file-tags (mapconcat #'identity org-file-tags "
"))))
(defun pcomplete/org-mode/file-option/language ()
"Complete arguments for the #+LANGUAGE file option."
@@ -264,13 +264,13 @@ When completing for #+STARTUP, for example, this function
returns
(require 'ox)
(pcomplete-here
(and org-export-select-tags
- (list (mapconcat 'identity org-export-select-tags " ")))))
+ (list (mapconcat #'identity org-export-select-tags " ")))))
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
(while (pcomplete-here
(let ((opts (pcomplete-uniquify-list
- (mapcar 'car org-startup-options))))
+ (mapcar #'car org-startup-options))))
;; Some options are mutually exclusive, and shouldn't be completed
;; against if certain other options have already been seen.
(dolist (arg pcomplete-args)
@@ -340,7 +340,8 @@ When completing for #+STARTUP, for example, this function
returns
"Complete against TeX-style HTML entity names."
(require 'org-entities)
(while (pcomplete-here
- (pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities)))
+ (pcomplete-uniquify-list
+ (remove nil (mapcar #'car-safe org-entities)))
(substring pcomplete-stub 1))))
(defun pcomplete/org-mode/todo ()
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index dd964e3..6c68645 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -106,7 +106,7 @@
(while (pcomplete-here (completion-table-in-turn
(pcmpl-gnu-make-rule-names)
(pcomplete-entries))
- nil 'identity))))
+ nil #'identity))))
(defun pcmpl-gnu-makefile-names ()
"Return a list of possible makefile names."
@@ -336,7 +336,7 @@ Return the new list."
(pcomplete-match-string 1 0)))))
(unless saw-option
(pcomplete-here
- (mapcar 'char-to-string
+ (mapcar #'char-to-string
(string-to-list
"01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))
(if (pcomplete-match "[xt]" 'first 1)
@@ -355,7 +355,7 @@ Return the new list."
(pcmpl-gnu-with-file-buffer
file (mapcar #'tar-header-name tar-parse-info)))))
(pcomplete-entries))
- nil 'identity))))
+ nil #'identity))))
;;;###autoload
@@ -391,7 +391,7 @@ Return the new list."
(string= prec "-execdir"))
(while (pcomplete-here* (funcall
pcomplete-command-completion-function)
(pcomplete-arg 'last) t))))
- (while (pcomplete-here (pcomplete-dirs) nil 'identity))))
+ (while (pcomplete-here (pcomplete-dirs) nil #'identity))))
;;;###autoload
(defalias 'pcomplete/gdb 'pcomplete/xargs)
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 2f42dbd..263d646 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -50,20 +50,20 @@
(while (pcomplete-here
(if (file-directory-p "/proc")
(directory-files "/proc" nil "\\`[0-9]+\\'"))
- nil 'identity)))
+ nil #'identity)))
;;;###autoload
(defun pcomplete/umount ()
"Completion for GNU/Linux `umount'."
(pcomplete-opt "hVafrnvt(pcmpl-linux-fs-types)")
(while (pcomplete-here (pcmpl-linux-mounted-directories)
- nil 'identity)))
+ nil #'identity)))
;;;###autoload
(defun pcomplete/mount ()
"Completion for GNU/Linux `mount'."
(pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?")
- (while (pcomplete-here (pcomplete-entries) nil 'identity)))
+ (while (pcomplete-here (pcomplete-entries) nil #'identity)))
(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 70273b9..c1aaf82 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -77,7 +77,7 @@ being via `pcmpl-ssh-known-hosts-file'."
(let ((pcomplete-help "(fileutils)rm invocation"))
(pcomplete-opt "dfirRv")
(while (pcomplete-here (pcomplete-all-entries) nil
- 'expand-file-name))))
+ #'expand-file-name))))
;;;###autoload
(defun pcomplete/xargs ()
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 61d8866..084f0e6 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -301,7 +301,8 @@ long options."
"nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
"pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
"rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
- "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
+ "tes" "thr" "ucp" "use" "voi" "zdi")
+ (match-string 2 cur)))
((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
(pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 891a5f6..3630c19 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -179,6 +179,7 @@ GRID is the grid of positions to click.")
(define-derived-mode 5x5-mode special-mode "5x5"
"A mode for playing `5x5'."
+ :interactive nil
(setq buffer-read-only t
truncate-lines t)
(buffer-disable-undo))
@@ -221,7 +222,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-new-game ()
"Start a new game of `5x5'."
- (interactive)
+ (interactive nil 5x5-mode)
(when (if (called-interactively-p 'interactive)
(5x5-y-or-n-p "Start a new game? ") t)
(setq 5x5-x-pos (/ 5x5-grid-size 2)
@@ -234,7 +235,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-quit-game ()
"Quit the current game of `5x5'."
- (interactive)
+ (interactive nil 5x5-mode)
(kill-buffer 5x5-buffer-name))
(defun 5x5-make-new-grid ()
@@ -782,7 +783,7 @@ Solutions are sorted from least to greatest Hamming weight."
Argument N is ignored."
;; For the time being n is ignored, the idea was to use some numeric
;; argument to show a limited amount of positions.
- (interactive "P")
+ (interactive "P" 5x5-mode)
(5x5-log-init)
(let ((solutions (5x5-solver 5x5-grid)))
(setq 5x5-solver-output
@@ -805,7 +806,7 @@ list. The list of solution is ordered by number of strokes,
so
rotating left just after calling `5x5-solve-suggest' will show
the solution with second least number of strokes, while rotating
right will show the solution with greatest number of strokes."
- (interactive "P")
+ (interactive "P" 5x5-mode)
(let ((len (length 5x5-solver-output)))
(when (>= len 3)
(setq n (if (integerp n) n 1)
@@ -839,7 +840,7 @@ right will show the solution with greatest number of
strokes."
If N is not supplied, rotate by 1. Similar to function
`5x5-solve-rotate-left' except that rotation is right instead of
lest."
- (interactive "P")
+ (interactive "P" 5x5-mode)
(setq n
(if (integerp n) (- n)
-1))
@@ -851,7 +852,7 @@ lest."
(defun 5x5-flip-current ()
"Make a move on the current cursor location."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
(5x5-made-move)
(unless 5x5-cracking
@@ -863,61 +864,61 @@ lest."
(defun 5x5-up ()
"Move up."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (zerop 5x5-y-pos)
(cl-decf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-down ()
"Move down."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (= 5x5-y-pos (1- 5x5-grid-size))
(cl-incf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-left ()
"Move left."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (zerop 5x5-x-pos)
(cl-decf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-right ()
"Move right."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (= 5x5-x-pos (1- 5x5-grid-size))
(cl-incf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-bol ()
"Move to beginning of line."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos 0)
(5x5-position-cursor))
(defun 5x5-eol ()
"Move to end of line."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos (1- 5x5-grid-size))
(5x5-position-cursor))
(defun 5x5-first ()
"Move to the first cell."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos 0
5x5-y-pos 0)
(5x5-position-cursor))
(defun 5x5-last ()
"Move to the last cell."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos (1- 5x5-grid-size)
5x5-y-pos (1- 5x5-grid-size))
(5x5-position-cursor))
(defun 5x5-randomize ()
"Randomize the grid."
- (interactive)
+ (interactive nil 5x5-mode)
(when (5x5-y-or-n-p "Start a new game with a random grid? ")
(setq 5x5-x-pos (/ 5x5-grid-size 2)
5x5-y-pos (/ 5x5-grid-size 2)
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 61b0878..13bcdcc 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -274,45 +274,45 @@ a reflection."
))
(defun bb-right (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (< bb-x 8))
(forward-char 2)
(setq bb-x (1+ bb-x))
(setq count (1- count))))
(defun bb-left (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (> bb-x -1))
(backward-char 2)
(setq bb-x (1- bb-x))
(setq count (1- count))))
(defun bb-up (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (> bb-y -1))
(with-no-warnings (previous-line))
(setq bb-y (1- bb-y))
(setq count (1- count))))
(defun bb-down (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (< bb-y 8))
(with-no-warnings (next-line))
(setq bb-y (1+ bb-y))
(setq count (1- count))))
(defun bb-eol ()
- (interactive)
+ (interactive nil blackbox-mode)
(setq bb-x 8)
(bb-goto (cons bb-x bb-y)))
(defun bb-bol ()
- (interactive)
+ (interactive nil blackbox-mode)
(setq bb-x -1)
(bb-goto (cons bb-x bb-y)))
(defun bb-romp ()
- (interactive)
+ (interactive nil blackbox-mode)
(cond
((and
(or (= bb-x -1) (= bb-x 8))
@@ -379,7 +379,7 @@ a reflection."
(defun bb-done ()
"Finish the game and report score."
- (interactive)
+ (interactive nil blackbox-mode)
(let (bogus-balls)
(cond
((not (= (length bb-balls-placed) (length bb-board)))
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 524ca81..9b2626b 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -1,4 +1,4 @@
-;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
+;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers -*-
lexical-binding: t; -*-
;;
;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
;;
@@ -71,7 +71,7 @@
;; Emacs commands.
;;
;; Decipher supports Font Lock mode. To use it, you can also add
-;; (add-hook 'decipher-mode-hook 'turn-on-font-lock)
+;; (add-hook 'decipher-mode-hook #'turn-on-font-lock)
;; See the variable `decipher-font-lock-keywords' if you want to customize
;; the faces used. I'd like to thank Simon Marshall for his help in making
;; Decipher work well with Font Lock.
@@ -84,6 +84,8 @@
;; 1. The consonant-line shortcut
;; 2. More functions for analyzing ciphertext
+;;; Code:
+
;;;===================================================================
;;; Variables:
;;;===================================================================
@@ -139,20 +141,20 @@ the tail of the list."
(defvar decipher-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "A" 'decipher-show-alphabet)
- (define-key map "C" 'decipher-complete-alphabet)
- (define-key map "D" 'decipher-digram-list)
- (define-key map "F" 'decipher-frequency-count)
- (define-key map "M" 'decipher-make-checkpoint)
- (define-key map "N" 'decipher-adjacency-list)
- (define-key map "R" 'decipher-restore-checkpoint)
- (define-key map "U" 'decipher-undo)
- (define-key map " " 'decipher-keypress)
- (define-key map [remap undo] 'decipher-undo)
- (define-key map [remap advertised-undo] 'decipher-undo)
+ (define-key map "A" #'decipher-show-alphabet)
+ (define-key map "C" #'decipher-complete-alphabet)
+ (define-key map "D" #'decipher-digram-list)
+ (define-key map "F" #'decipher-frequency-count)
+ (define-key map "M" #'decipher-make-checkpoint)
+ (define-key map "N" #'decipher-adjacency-list)
+ (define-key map "R" #'decipher-restore-checkpoint)
+ (define-key map "U" #'decipher-undo)
+ (define-key map " " #'decipher-keypress)
+ (define-key map [remap undo] #'decipher-undo)
+ (define-key map [remap advertised-undo] #'decipher-undo)
(let ((key ?a))
(while (<= key ?z)
- (define-key map (vector key) 'decipher-keypress)
+ (define-key map (vector key) #'decipher-keypress)
(cl-incf key)))
map)
"Keymap for Decipher mode.")
@@ -161,24 +163,21 @@ the tail of the list."
(defvar decipher-stats-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "D" 'decipher-digram-list)
- (define-key map "F" 'decipher-frequency-count)
- (define-key map "N" 'decipher-adjacency-list)
+ (define-key map "D" #'decipher-digram-list)
+ (define-key map "F" #'decipher-frequency-count)
+ (define-key map "N" #'decipher-adjacency-list)
map)
-"Keymap for Decipher-Stats mode.")
+ "Keymap for Decipher-Stats mode.")
-(defvar decipher-mode-syntax-table nil
- "Decipher mode syntax table")
-
-(if decipher-mode-syntax-table
- ()
+(defvar decipher-mode-syntax-table
(let ((table (make-syntax-table))
(c ?0))
(while (<= c ?9)
(modify-syntax-entry c "_" table) ;Digits are not part of words
(cl-incf c))
- (setq decipher-mode-syntax-table table)))
+ table)
+ "Decipher mode syntax table")
(defvar-local decipher-alphabet nil)
;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
@@ -214,7 +213,6 @@ list of such cons cells.")
(defvar decipher--freqs)
;;;===================================================================
-;;; Code:
;;;===================================================================
;; Main entry points:
;;--------------------------------------------------------------------
@@ -256,7 +254,7 @@ ABCDEFGHIJKLMNOPQRSTUVWXYZ -*-decipher-*-\n)\n\n")
(decipher-mode))
;;;###autoload
-(defun decipher-mode ()
+(define-derived-mode decipher-mode nil "Decipher"
"Major mode for decrypting monoalphabetic substitution ciphers.
Lower-case letters enter plaintext.
Upper-case letters are commands.
@@ -272,16 +270,10 @@ The most useful commands are:
Show adjacency list for current letter (lists letters appearing next to it)
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)"
- (interactive)
- (kill-all-local-variables)
(setq buffer-undo-list t ;Disable undo
- indent-tabs-mode nil ;Do not use tab characters
- major-mode 'decipher-mode
- mode-name "Decipher")
+ indent-tabs-mode nil) ;Do not use tab characters
(if decipher-force-uppercase
(setq case-fold-search nil)) ;Case is significant when searching
- (use-local-map decipher-mode-map)
- (set-syntax-table decipher-mode-syntax-table)
(unless (= (point-min) (point-max))
(decipher-read-alphabet))
(setq-local font-lock-defaults
@@ -291,7 +283,6 @@ The most useful commands are:
(lambda () (setq buffer-read-only nil
buffer-undo-list nil))
nil t)
- (run-mode-hooks 'decipher-mode-hook)
(setq buffer-read-only t))
(put 'decipher-mode 'mode-class 'special)
@@ -314,10 +305,10 @@ The most useful commands are:
((= ?> first-char)
nil)
((= ?\( first-char)
- (setq decipher-function 'decipher-alphabet-keypress)
+ (setq decipher-function #'decipher-alphabet-keypress)
t)
((= ?\) first-char)
- (setq decipher-function 'decipher-alphabet-keypress)
+ (setq decipher-function #'decipher-alphabet-keypress)
nil)
(t
(error "Bad location")))))
@@ -456,7 +447,7 @@ The most useful commands are:
(decipher-insert plain-char)
(setq case-fold-search t ;Case is not significant
cipher-string (downcase cipher-string))
- (let ((font-lock-fontify-region-function 'ignore))
+ (let ((font-lock-fontify-region-function #'ignore))
;; insert-and-inherit will pick the right face automatically
(while (search-forward-regexp "^:" nil t)
(setq bound (point-at-eol))
@@ -868,12 +859,12 @@ Creates the statistics buffer if it doesn't exist."
(aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
(progn
- (decipher-loop-no-breaks 'decipher--analyze)
+ (decipher-loop-no-breaks #'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
(while (>= (cl-decf i) 0)
(aset (aref decipher--after i) 26 0))))
- (decipher-loop-with-breaks 'decipher--analyze))
+ (decipher-loop-with-breaks #'decipher--analyze))
(message "Processing results...")
(setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram
;; Sort the digram list by frequency and alphabetical order:
@@ -954,18 +945,12 @@ Creates the statistics buffer if it doesn't exist."
;; Statistics Buffer:
;;====================================================================
-(defun decipher-stats-mode ()
+(define-derived-mode decipher-stats-mode nil "Decipher-Stats"
"Major mode for displaying ciphertext statistics."
- (interactive)
- (kill-all-local-variables)
(setq buffer-read-only t
buffer-undo-list t ;Disable undo
case-fold-search nil ;Case is significant when searching
- indent-tabs-mode nil ;Do not use tab characters
- major-mode 'decipher-stats-mode
- mode-name "Decipher-Stats")
- (use-local-map decipher-stats-mode-map)
- (run-mode-hooks 'decipher-stats-mode-hook))
+ indent-tabs-mode nil)) ;Do not use tab characters
(put 'decipher-stats-mode 'mode-class 'special)
;;--------------------------------------------------------------------
@@ -1001,9 +986,8 @@ if it can't, it signals an error."
(let ((stats-name (concat "*" (buffer-name) "*")))
(setq decipher-stats-buffer
(if (eq 'decipher-stats-mode
- (cdr-safe (assoc 'major-mode
- (buffer-local-variables
- (get-buffer stats-name)))))
+ (buffer-local-value 'major-mode
+ (get-buffer stats-name)))
;; We just lost track of the statistics buffer:
(get-buffer stats-name)
(generate-new-buffer stats-name))))
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 8db40d7..0a45885 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -28,39 +28,36 @@
;; RULES:
;;
;; Gomoku is a game played between two players on a rectangular board. Each
-;; player, in turn, marks a free square of its choice. The winner is the first
+;; player, in turn, marks a free square of its choice. The winner is the first
;; one to mark five contiguous squares in any direction (horizontally,
;; vertically or diagonally).
;;
;; I have been told that, in "The TRUE Gomoku", some restrictions are made
;; about the squares where one may play, or else there is a known forced win
-;; for the first player. This program has no such restriction, but it does not
+;; for the first player. This program has no such restriction, but it does not
;; know about the forced win, nor do I.
-;; See http://renju.se/rif/r1rulhis.htm for more information.
-
+;; See https://renju.se/rif/r1rulhis.htm for more information.
;; There are two main places where you may want to customize the program: key
-;; bindings and board display. These features are commented in the code. Go
+;; bindings and board display. These features are commented in the code. Go
;; and see.
-
;; HOW TO USE:
;;
-;; The command "M-x gomoku" displays a
-;; board, the size of which depends on the size of the current window. The
-;; size of the board is easily modified by giving numeric arguments to the
-;; gomoku command and/or by customizing the displaying parameters.
+;; The command `M-x gomoku' displays a board, the size of which depends on the
+;; size of the current window. The size of the board is easily modified by
+;; giving numeric arguments to the gomoku command and/or by customizing the
+;; displaying parameters.
;;
-;; Emacs plays when it is its turn. When it is your turn, just put the cursor
+;; Emacs plays when it is its turn. When it is your turn, just put the cursor
;; on the square where you want to play and hit RET, or X, or whatever key you
-;; bind to the command gomoku-human-plays. When it is your turn, Emacs is
+;; bind to the command `gomoku-human-plays'. When it is your turn, Emacs is
;; idle: you may switch buffers, read your mail, ... Just come back to the
;; *Gomoku* buffer and resume play.
-
;; ALGORITHM:
;;
-;; The algorithm is briefly described in section "THE SCORE TABLE". Some
+;; The algorithm is briefly described in section "THE SCORE TABLE". Some
;; parameters may be modified if you want to change the style exhibited by the
;; program.
@@ -86,13 +83,15 @@ One useful value to include is `turn-on-font-lock' to
highlight the pieces."
"Name of the Gomoku buffer.")
;; You may change these values if you have a small screen or if the squares
-;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
+;; look rectangular.
(defconst gomoku-square-width 4
- "Horizontal spacing between squares on the Gomoku board.")
+ "Horizontal spacing between squares on the Gomoku board.
+SHOULD be at least 2 (MUST BE at least 1).")
(defconst gomoku-square-height 2
- "Vertical spacing between squares on the Gomoku board.")
+ "Vertical spacing between squares on the Gomoku board.
+SHOULD be at least 2 (MUST BE at least 1).")
(defconst gomoku-x-offset 3
"Number of columns between the Gomoku board and the side of the window.")
@@ -270,13 +269,13 @@ Other useful commands:\n
;; internested 5-tuples of contiguous squares (called qtuples).
;;
;; The aim of the program is to fill one qtuple with its O's while preventing
-;; you from filling another one with your X's. To that effect, it computes a
-;; score for every qtuple, with better qtuples having better scores. Of
+;; you from filling another one with your X's. To that effect, it computes a
+;; score for every qtuple, with better qtuples having better scores. Of
;; course, the score of a qtuple (taken in isolation) is just determined by
-;; its contents as a set, i.e. not considering the order of its elements. The
+;; its contents as a set, i.e. not considering the order of its elements. The
;; highest score is given to the "OOOO" qtuples because playing in such a
-;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
-;; not playing in it is just losing the game, and so on. Note that a
+;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
+;; not playing in it is just losing the game, and so on. Note that a
;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
;; has score zero because there is no more any point in playing in it, from
;; both an attacking and a defending point of view.
@@ -284,11 +283,11 @@ Other useful commands:\n
;; Given the score of every qtuple, the score of a given free square on the
;; board is just the sum of the scores of all the qtuples to which it belongs,
;; because playing in that square is playing in all its containing qtuples at
-;; once. And it is that function which takes into account the internesting of
+;; once. And it is that function which takes into account the internesting of
;; the qtuples.
;;
;; This algorithm is rather simple but anyway it gives a not so dumb level of
-;; play. It easily extends to "n-dimensional Gomoku", where a win should not
+;; play. It easily extends to "n-dimensional Gomoku", where a win should not
;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
;; should be preferred.
@@ -323,8 +322,8 @@ Other useful commands:\n
;; because "a" mainly belongs to six "XX" qtuples (the others are less
;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other
;; conditions are required to obtain sensible moves, but the previous example
-;; should illustrate the point. If you manage to improve on these values,
-;; please send me a note. Thanks.
+;; should illustrate the point. If you manage to improve on these values,
+;; please send me a note. Thanks.
;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the
@@ -343,9 +342,9 @@ Other useful commands:\n
;; If you do not modify drastically the previous constants, the only way for a
;; square to have a score higher than gomoku-OOOOscore is to belong to a "OOOO"
-;; qtuple, thus to be a winning move. Similarly, the only way for a square to
+;; qtuple, thus to be a winning move. Similarly, the only way for a square to
;; have a score between gomoku-XXXXscore and gomoku-OOOOscore is to belong to
a "XXXX"
-;; qtuple. We may use these considerations to detect when a given move is
+;; qtuple. We may use these considerations to detect when a given move is
;; winning or losing.
(defconst gomoku-winning-threshold gomoku-OOOOscore
@@ -357,8 +356,8 @@ Other useful commands:\n
(defun gomoku-strongest-square ()
"Compute index of free square with highest score, or nil if none."
- ;; We just have to loop other all squares. However there are two problems:
- ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
+ ;; We just have to loop other all squares. However there are two problems:
+ ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
;; up future searches, we set the score of padding or occupied squares
;; to -1 whenever we meet them.
;; 2/ We want to choose randomly between equally good moves.
@@ -378,7 +377,7 @@ Other useful commands:\n
best-square square
score-max score)
(aset gomoku-score-table square -1))) ; no: kill it !
- ;; If score is equally good, choose randomly. But first check freedom:
+ ;; If score is equally good, choose randomly. But first check freedom:
((not (zerop (aref gomoku-board square)))
(aset gomoku-score-table square -1))
((zerop (random (setq count (1+ count))))
@@ -392,11 +391,11 @@ Other useful commands:\n
;;;
;; At initialization the board is empty so that every qtuple amounts for
-;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score
times the number
-;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
-;; are sufficiently far from the sides. As computing the number is time
+;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score
times the number
+;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
+;; are sufficiently far from the sides. As computing the number is time
;; consuming, we initialize every square with 20*gomoku-nil-score and then only
-;; consider squares at less than 5 squares from one side. We speed this up by
+;; consider squares at less than 5 squares from one side. We speed this up by
;; taking symmetry into account.
;; Also, as it is likely that successive games will be played on a board with
;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
@@ -451,7 +450,7 @@ Other useful commands:\n
"Return the number of qtuples containing square I,J."
;; This function is complicated because we have to deal
;; with ugly cases like 3 by 6 boards, but it works.
- ;; If you have a simpler (and correct) solution, send it to me. Thanks !
+ ;; If you have a simpler (and correct) solution, send it to me. Thanks !
(let ((left (min 4 (1- i)))
(right (min 4 (- gomoku-board-width i)))
(up (min 4 (1- j)))
@@ -477,9 +476,9 @@ Other useful commands:\n
;;;
;; We do not provide functions for computing the SCORE-TABLE given the
-;; contents of the BOARD. This would involve heavy nested loops, with time
-;; proportional to the size of the board. It is better to update the
-;; SCORE-TABLE after each move. Updating needs not modify more than 36
+;; contents of the BOARD. This would involve heavy nested loops, with time
+;; proportional to the size of the board. It is better to update the
+;; SCORE-TABLE after each move. Updating needs not modify more than 36
;; squares: it is done in constant time.
(defun gomoku-update-score-table (square dval)
@@ -782,7 +781,7 @@ Use \\[describe-mode] for more info."
(defun gomoku-emacs-plays ()
"Compute Emacs next move and play it."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -815,7 +814,7 @@ Use \\[describe-mode] for more info."
;; pixels, event's (X . Y) is a character's top-left corner.
(defun gomoku-click (click)
"Position at the square where you click."
- (interactive "e")
+ (interactive "e" gomoku-mode)
(and (windowp (posn-window (setq click (event-end click))))
(numberp (posn-point click))
(select-window (posn-window click))
@@ -844,7 +843,7 @@ Use \\[describe-mode] for more info."
(defun gomoku-mouse-play (click)
"Play at the square where you click."
- (interactive "e")
+ (interactive "e" gomoku-mode)
(if (gomoku-click click)
(gomoku-human-plays)))
@@ -852,7 +851,7 @@ Use \\[describe-mode] for more info."
"Signal to the Gomoku program that you have played.
You must have put the cursor on the square where you want to play.
If the game is finished, this command requests for another game."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -880,7 +879,7 @@ If the game is finished, this command requests for another
game."
(defun gomoku-human-takes-back ()
"Signal to the Gomoku program that you wish to take back your last move."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -904,7 +903,7 @@ If the game is finished, this command requests for another
game."
(defun gomoku-human-resigns ()
"Signal to the Gomoku program that you may want to resign."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -1162,20 +1161,20 @@ If the game is finished, this command requests for
another game."
;; the screen.
(defun gomoku-move-right ()
"Move point right one column on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (< (gomoku-point-x) gomoku-board-width)
(forward-char gomoku-square-width)))
(defun gomoku-move-left ()
"Move point left one column on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (> (gomoku-point-x) 1)
(backward-char gomoku-square-width)))
;; previous-line and next-line don't work right with intangible newlines
(defun gomoku-move-down ()
"Move point down one row on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (< (gomoku-point-y) gomoku-board-height)
(let ((column (current-column)))
(forward-line gomoku-square-height)
@@ -1183,7 +1182,7 @@ If the game is finished, this command requests for
another game."
(defun gomoku-move-up ()
"Move point up one row on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (> (gomoku-point-y) 1)
(let ((column (current-column)))
(forward-line (- gomoku-square-height))
@@ -1191,36 +1190,36 @@ If the game is finished, this command requests for
another game."
(defun gomoku-move-ne ()
"Move point North East on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-up)
(gomoku-move-right))
(defun gomoku-move-se ()
"Move point South East on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-down)
(gomoku-move-right))
(defun gomoku-move-nw ()
"Move point North West on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-up)
(gomoku-move-left))
(defun gomoku-move-sw ()
"Move point South West on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-down)
(gomoku-move-left))
(defun gomoku-beginning-of-line ()
"Move point to first square on the Gomoku board row."
- (interactive)
+ (interactive nil gomoku-mode)
(move-to-column gomoku-x-offset))
(defun gomoku-end-of-line ()
"Move point to last square on the Gomoku board row."
- (interactive)
+ (interactive nil gomoku-mode)
(move-to-column (+ gomoku-x-offset
(* gomoku-square-width (1- gomoku-board-width)))))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index a759394..4d4becf 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -73,8 +73,7 @@ so that it is considered safe, see `enable-local-variables'.")
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
:type 'regexp
- :version "24.3" ; previously defconst
- :group 'bug-reference)
+ :version "24.3") ; previously defconst
;;;###autoload
(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index f516664..bef99f2 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -69,7 +69,6 @@
(defcustom cfengine-indent 2
"Size of a CFEngine indentation step in columns."
- :group 'cfengine
:type 'integer)
(defcustom cfengine-cf-promises
@@ -86,7 +85,6 @@ Used for syntax discovery and checking. Set to nil to disable
the `compile-command' override. In that case, the ElDoc support
will use a fallback syntax definition."
:version "24.4"
- :group 'cfengine
:type '(choice file (const nil)))
(defcustom cfengine-parameters-indent '(promise pname 2)
@@ -145,7 +143,6 @@ bundle agent rcfiles
}
"
:version "24.4"
- :group 'cfengine
:type '(list
(choice (const :tag "Anchor at beginning of promise" promise)
(const :tag "Anchor at beginning of line" bol))
@@ -799,7 +796,6 @@ bundle agent rcfiles
(defcustom cfengine-mode-abbrevs nil
"Abbrevs for CFEngine2 mode."
- :group 'cfengine
:type '(repeat (list (string :tag "Name")
(string :tag "Expansion")
(choice :tag "Hook" (const nil) function))))
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 1a45b1c..820867a 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -99,13 +99,11 @@
(defcustom c-macro-shrink-window-flag nil
"Non-nil means shrink the *Macroexpansion* window to fit its contents."
- :type 'boolean
- :group 'c-macro)
+ :type 'boolean)
(defcustom c-macro-prompt-flag nil
"Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
- :type 'boolean
- :group 'c-macro)
+ :type 'boolean)
(defcustom c-macro-preprocessor
(cond ;; Solaris has it in an unusual place.
@@ -129,13 +127,11 @@
If you change this, be sure to preserve the `-C' (don't strip comments)
option, or to set an equivalent one."
- :type 'string
- :group 'c-macro)
+ :type 'string)
(defcustom c-macro-cppflags ""
"Preprocessor flags used by `c-macro-expand'."
- :type 'string
- :group 'c-macro)
+ :type 'string)
(defconst c-macro-buffer-name "*Macroexpansion*")
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index a70e8e3..44a7526 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -440,12 +440,6 @@ after reload."
:type 'boolean
:group 'cperl-speed)
-(defcustom cperl-imenu-addback nil
- "Not-nil means add backreferences to generated `imenu's.
-May require patched `imenu' and `imenu-go'. Obsolete."
- :type 'boolean
- :group 'cperl-help-system)
-
(defcustom cperl-max-help-size 66
"Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
:type '(choice integer (const nil))
@@ -659,8 +653,8 @@ Run Perl/Tools/Insert-spaces-if-needed to fix your lazy
typing.
Switch auto-help on/off with Perl/Tools/Auto-help.
-Though with contemporary Emaxen CPerl mode should maintain the correct
-parsing of Perl even when editing, sometimes it may be lost. Fix this by
+Though CPerl mode should maintain the correct parsing of Perl even when
+editing, sometimes it may be lost. Fix this by
\\[normal-mode]
@@ -676,63 +670,20 @@ micro-docs on what I know about CPerl problems.")
"Description of problems in CPerl mode.
`fill-paragraph' on a comment may leave the point behind the
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
-to detect it and bulk out).
-
-See documentation of a variable `cperl-problems-old-emaxen' for the
-problems which disappear if you upgrade Emacs to a reasonably new
-version (20.3 for Emacs).")
+to detect it and bulk out).")
(defvar cperl-problems-old-emaxen 'please-ignore-this-line
- "Description of problems in CPerl mode specific for older Emacs versions.
-
-Emacs had a _very_ restricted syntax parsing engine until version
-20.1. Most problems below are corrected starting from this version of
-Emacs, and all of them should be fixed in version 20.3. (Or apply
-patches to Emacs 19.33/34 - see tips.)
-
-Note that even with newer Emacsen in some very rare cases the details
-of interaction of `font-lock' and syntaxification may be not cleaned
-up yet. You may get slightly different colors basing on the order of
-fontification and syntaxification. Say, the initial faces is correct,
-but editing the buffer breaks this.
-
-Even with older Emacsen CPerl mode tries to corrects some Emacs
-misunderstandings, however, for efficiency reasons the degree of
-correction is different for different operations. The partially
-corrected problems are: POD sections, here-documents, regexps. The
-operations are: highlighting, indentation, electric keywords, electric
-braces.
-
-This may be confusing, since the regexp s#//#/#; may be highlighted
-as a comment, but it will be recognized as a regexp by the indentation
-code. Or the opposite case, when a POD section is highlighted, but
-may break the indentation of the following code (though indentation
-should work if the balance of delimiters is not broken by POD).
-
-The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think of is
-to insert it as $ {aaa} (valid in perl5, not in perl4).
-
-Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transposition is not always possible.
-
-The solution is to upgrade your Emacs or patch an older one. Note
-that Emacs 20.2 has some bugs related to `syntax-table' text
-properties. Patches are available on the main CPerl download site,
-and on CPAN.
-
-If these bugs cannot be fixed on your machine (say, you have an inferior
-environment and cannot recompile), you may still disable all the fancy stuff
-via `cperl-use-syntax-table-text-property'.")
+ "This used to contain a description of problems in CPerl mode
+specific for very old Emacs versions. This is no longer relevant
+and has been removed.")
+(make-obsolete-variable 'cperl-problems-old-emaxen nil "28.1")
(defvar cperl-praise 'please-ignore-this-line
"Advantages of CPerl mode.
0) It uses the newest `syntax-table' property ;-);
-1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
-mode - but the latter number may have improved too in last years) even
-with old Emaxen which do not support `syntax-table' property.
+1) It does 99% of Perl syntax correct.
When using `syntax-table' property for syntax assist hints, it should
handle 99.995% of lines correct - or somesuch. It automatically
@@ -813,8 +764,7 @@ the settings present before the switch.
9) When doing indentation of control constructs, may correct
line-breaks/spacing between elements of the construct.
-10) Uses a linear-time algorithm for indentation of regions (on Emaxen with
-capable syntax engines).
+10) Uses a linear-time algorithm for indentation of regions.
11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.
")
@@ -838,8 +788,8 @@ syntax-parsing routines, and marks them up so that either
A1) CPerl may work around these deficiencies (for big chunks, mostly
PODs and HERE-documents), or
- A2) On capable Emaxen CPerl will use improved syntax-handling
- which reads mark-up hints directly.
+ A2) CPerl will use improved syntax-handling which reads mark-up
+ hints directly.
The scan in case A2 is much more comprehensive, thus may be slower.
@@ -1019,9 +969,12 @@ versions of Emacs."
"Abbrev table in use in CPerl mode buffers."
:parents (list cperl-mode-electric-keywords-abbrev-table))
-(when (boundp 'edit-var-mode-alist)
- ;; FIXME: What package uses this?
- (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
+;; ;; TODO: Commented out as we don't know what it is used for. If
+;; ;; there are no bug reports about this for Emacs 28.1, this
+;; ;; can probably be removed. (Code search online reveals nothing.)
+;; (when (boundp 'edit-var-mode-alist)
+;; ;; FIXME: What package uses this?
+;; (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
(defvar cperl-mode-map
(let ((map (make-sparse-keymap)))
@@ -1257,6 +1210,153 @@ versions of Emacs."
The expansion is entirely correct because it uses the C preprocessor."
t)
+
+;;; Perl Grammar Components
+;;
+;; The following regular expressions are building blocks for a
+;; minimalistic Perl grammar, to be used instead of individual (and
+;; not always consistent) literal regular expressions.
+
+(defconst cperl--basic-identifier-regexp
+ (rx (sequence (or alpha "_") (* (or word "_"))))
+ "A regular expression for the name of a \"basic\" Perl variable.
+Neither namespace separators nor sigils are included. As is,
+this regular expression applies to labels,subroutine calls where
+the ampersand sigil is not required, and names of subroutine
+attributes.")
+
+(defconst cperl--label-regexp
+ (rx-to-string
+ `(sequence
+ symbol-start
+ (regexp ,cperl--basic-identifier-regexp)
+ (0+ space)
+ ":"))
+ "A regular expression for a Perl label.
+By convention, labels are uppercase alphabetics, but this isn't
+enforced.")
+
+(defconst cperl--normal-identifier-regexp
+ (rx-to-string
+ `(or
+ (sequence
+ (1+ (sequence
+ (opt (regexp ,cperl--basic-identifier-regexp))
+ "::"))
+ (opt (regexp ,cperl--basic-identifier-regexp)))
+ (regexp ,cperl--basic-identifier-regexp)))
+ "A regular expression for a Perl variable name with optional namespace.
+Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that
+is a legal variable name).")
+
+(defconst cperl--special-identifier-regexp
+ (rx-to-string
+ `(or
+ (1+ digit) ; $0, $1, $2, ...
+ (sequence "^" (any "A-Z" "]^_?\\")) ; $^V
+ (sequence "{" (0+ space) ; ${^MATCH}
+ "^" (any "A-Z" "]^_?\\")
+ (0+ (any "A-Z" "_" digit))
+ (0+ space) "}")
+ (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or
${
+ "The list of Perl \"punctuation\" variables, as listed in perlvar.")
+
+(defconst cperl--ws-regexp
+ (rx-to-string
+ '(or space "\n"))
+ "Regular expression for a single whitespace in Perl.")
+
+(defconst cperl--eol-comment-regexp
+ (rx-to-string
+ '(sequence "#" (0+ (not (in "\n"))) "\n"))
+ "Regular expression for a single end-of-line comment in Perl")
+
+(defconst cperl--ws-or-comment-regexp
+ (rx-to-string
+ `(1+
+ (or
+ (regexp ,cperl--ws-regexp)
+ (regexp ,cperl--eol-comment-regexp))))
+ "Regular expression for a sequence of whitespace and comments in Perl.")
+
+(defconst cperl--ows-regexp
+ (rx-to-string
+ `(opt (regexp ,cperl--ws-or-comment-regexp)))
+ "Regular expression for optional whitespaces or comments in Perl")
+
+(defconst cperl--version-regexp
+ (rx-to-string
+ `(or
+ (sequence (opt "v")
+ (>= 2 (sequence (1+ digit) "."))
+ (1+ digit)
+ (opt (sequence "_" (1+ word))))
+ (sequence (1+ digit)
+ (opt (sequence "." (1+ digit)))
+ (opt (sequence "_" (1+ word))))))
+ "A sequence for recommended version number schemes in Perl.")
+
+(defconst cperl--package-regexp
+ (rx-to-string
+ `(sequence
+ "package" ; FIXME: the "class" and "role" keywords need to be
+ ; recognized soon...ish.
+ (regexp ,cperl--ws-or-comment-regexp)
+ (group (regexp ,cperl--normal-identifier-regexp))
+ (opt
+ (sequence
+ (1+ (regexp ,cperl--ws-or-comment-regexp))
+ (group (regexp ,cperl--version-regexp))))))
+ "A regular expression for package NAME VERSION in Perl.
+Contains two groups for the package name and version.")
+
+(defconst cperl--package-for-imenu-regexp
+ (rx-to-string
+ `(sequence
+ (regexp ,cperl--package-regexp)
+ (regexp ,cperl--ows-regexp)
+ (group (or ";" "{"))))
+ "A regular expression to collect package names for `imenu`.
+Catches \"package NAME;\", \"package NAME VERSION;\", \"package
+NAME BLOCK\" and \"package NAME VERSION BLOCK.\" Contains three
+groups: Two from `cperl--package-regexp` for the package name and
+version, and a third to detect \"package BLOCK\" syntax.")
+
+(defconst cperl--sub-name-regexp
+ (rx-to-string
+ `(sequence
+ (optional (sequence (group (or "my" "state" "our"))
+ (regexp ,cperl--ws-or-comment-regexp)))
+ "sub" ; FIXME: the "method" and maybe "fun" keywords need to be
+ ; recognized soon...ish.
+ (regexp ,cperl--ws-or-comment-regexp)
+ (group (regexp ,cperl--normal-identifier-regexp))))
+ "A regular expression to detect a subroutine start.
+Contains two groups: One for to distinguish lexical from
+\"normal\" subroutines and one for the subroutine name.")
+
+(defconst cperl--pod-heading-regexp
+ (rx-to-string
+ `(sequence
+ line-start "=head"
+ (group (in "1-4"))
+ (1+ (in " \t"))
+ (group (1+ (not (in "\n"))))
+ line-end)) ; that line-end seems to be redundant?
+ "A regular expression to detect a POD heading.
+Contains two groups: One for the heading level, and one for the
+heading text.")
+
+(defconst cperl--imenu-entries-regexp
+ (rx-to-string
+ `(or
+ (regexp ,cperl--package-for-imenu-regexp) ; 1..3
+ (regexp ,cperl--sub-name-regexp) ; 4..5
+ (regexp ,cperl--pod-heading-regexp))) ; 6..7
+ "A regular expression to collect stuff that goes into the `imenu` index.
+Covers packages, subroutines, and POD headings.")
+
+
;; These two must be unwound, otherwise take exponential time
(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
"Regular expression to match optional whitespace with interspersed comments.
@@ -1268,8 +1368,7 @@ Should contain exactly one group.")
Should contain exactly one group.")
-;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
-;; `cperl-outline-regexp', `defun-prompt-regexp'.
+;; Is incorporated in `cperl-outline-regexp', `defun-prompt-regexp'.
;; Details of groups in this may be used in several functions; see comments
;; near mentioned above variable(s)...
;; sub($$):lvalue{} sub:lvalue{} Both allowed...
@@ -1396,13 +1495,15 @@ the last)."
(defvar cperl-font-lock-multiline nil)
(defvar cperl-font-locking nil)
-;; NB as it stands the code in cperl-mode assumes this only has one
-;; element. Since XEmacs 19 support has been dropped, this could all be
simplified.
-(defvar cperl-compilation-error-regexp-alist
+(defvar cperl-compilation-error-regexp-list
;; This look like a paranoiac regexp: could anybody find a better one?
(which WORKS).
- '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
- 2 3))
- "Alist that specifies how to match errors in perl output.")
+ '("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
+ 2 3)
+ "List that specifies how to match errors in Perl output.")
+
+(defvar cperl-compilation-error-regexp-alist)
+(make-obsolete-variable 'cperl-compilation-error-regexp-alist
+ 'cperl-compilation-error-regexp-list "28.1")
(defvar compilation-error-regexp-alist)
@@ -1512,8 +1613,7 @@ span the needed amount of lines.
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections. With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
+here-docs sections. Results of scan are used for indentation too.
Variables controlling indentation style:
`cperl-tab-always-indent'
@@ -1639,19 +1739,18 @@ or as help on variables `cperl-tips', `cperl-problems',
(setq-local imenu-sort-function nil)
(setq-local vc-rcs-header cperl-vc-rcs-header)
(setq-local vc-sccs-header cperl-vc-sccs-header)
- (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (setq-local compilation-error-regexp-alist-alist
- (cons (cons 'cperl (car
cperl-compilation-error-regexp-alist))
- compilation-error-regexp-alist-alist))
- (if (fboundp 'compilation-build-compilation-error-regexp-alist)
- (let ((f 'compilation-build-compilation-error-regexp-alist))
- (funcall f))
- (make-local-variable 'compilation-error-regexp-alist)
- (push 'cperl compilation-error-regexp-alist)))
- ((boundp 'compilation-error-regexp-alist);; xemacs 19.x
- (setq-local compilation-error-regexp-alist
- (append cperl-compilation-error-regexp-alist
- compilation-error-regexp-alist))))
+ (when (boundp 'compilation-error-regexp-alist-alist)
+ ;; The let here is just a compatibility kludge for the obsolete
+ ;; variable `cperl-compilation-error-regexp-alist'. It can be removed
+ ;; when that variable is removed.
+ (let ((regexp (if (boundp 'cperl-compilation-error-regexp-alist)
+ (car cperl-compilation-error-regexp-alist)
+ cperl-compilation-error-regexp-list)))
+ (setq-local compilation-error-regexp-alist-alist
+ (cons (cons 'cperl regexp)
+ compilation-error-regexp-alist-alist)))
+ (make-local-variable 'compilation-error-regexp-alist)
+ (push 'cperl compilation-error-regexp-alist))
(setq-local font-lock-defaults
'((cperl-load-font-lock-keywords
cperl-load-font-lock-keywords-1
@@ -5188,117 +5287,80 @@ indentation and initial hashes. Behaves usually
outside of comment."
;; Previous space could have gone:
(or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
-(defun cperl-imenu-addback (lst &optional isback name)
- ;; We suppose that the lst is a DAG, unless the first element only
- ;; loops back, and ISBACK is set. Thus this function cannot be
- ;; applied twice without ISBACK set.
- (cond ((not cperl-imenu-addback) lst)
- (t
- (or name
- (setq name "+++BACK+++"))
- (mapc (lambda (elt)
- (if (and (listp elt) (listp (cdr elt)))
- (progn
- ;; In the other order it goes up
- ;; one level only ;-(
- (setcdr elt (cons (cons name lst)
- (cdr elt)))
- (cperl-imenu-addback (cdr elt) t name))))
- (if isback (cdr lst) lst))
- lst)))
-
-(defun cperl-imenu--create-perl-index (&optional regexp)
- (require 'imenu) ; May be called from TAGS creator
- (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
+(defun cperl-imenu--create-perl-index ()
+ "Implement `imenu-create-index-function` for CPerl mode.
+This function relies on syntaxification to exclude lines which
+look like declarations but actually are part of a string, a
+comment, or POD."
+ (interactive) ; We'll remove that at some point
+ (goto-char (point-min))
+ (cperl-update-syntaxification (point-max))
+ (let ((case-fold-search nil)
+ (index-alist '())
+ (index-package-alist '())
+ (index-pod-alist '())
+ (index-sub-alist '())
(index-unsorted-alist '())
- (index-meth-alist '()) meth
- packages ends-ranges p marker is-proto
- is-pack index index1 name (end-range 0) package)
- (goto-char (point-min))
- (cperl-update-syntaxification (point-max))
- ;; Search for the function
- (progn ;;save-match-data
- (while (re-search-forward
- (or regexp cperl-imenu--function-name-regexp-perl)
- nil t)
- ;; 2=package-group, 5=package-name 8=sub-name
+ (package-stack '()) ; for package NAME BLOCK
+ (current-package "(main)")
+ (current-package-end (point-max))) ; end of package scope
+ ;; collect index entries
+ (while (re-search-forward cperl--imenu-entries-regexp nil t)
+ ;; First, check whether we have left the scope of previously
+ ;; recorded packages, and if so, eliminate them from the stack.
+ (while (< current-package-end (point))
+ (setq current-package (pop package-stack))
+ (setq current-package-end (pop package-stack)))
+ (let ((state (syntax-ppss))
+ name marker) ; for the "current" entry
(cond
- ((and ; Skip some noise if building tags
- (match-beginning 5) ; package name
- ;;(eq (char-after (match-beginning 2)) ?p) ; package
- (not (save-match-data
- (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
- nil)
- ((and
- (or (match-beginning 2)
- (match-beginning 8)) ; package or sub
- ;; Skip if quoted (will not skip multi-line ''-strings :-():
- (null (get-text-property (match-beginning 1) 'syntax-table))
- (null (get-text-property (match-beginning 1) 'syntax-type))
- (null (get-text-property (match-beginning 1) 'in-pod)))
- (setq is-pack (match-beginning 2))
- ;; (if (looking-at "([^()]*)[ \t\n\f]*")
- ;; (goto-char (match-end 0))) ; Messes what follows
- (setq meth nil
- p (point))
- (while (and ends-ranges (>= p (car ends-ranges)))
- ;; delete obsolete entries
- (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
- (setq package (or (car packages) "")
- end-range (or (car ends-ranges) 0))
- (if is-pack ; doing "package"
- (progn
- (if (match-beginning 5) ; named package
- (setq name (buffer-substring (match-beginning 5)
- (match-end 5))
- name (progn
- (set-text-properties 0 (length name) nil name)
- name)
- package (concat name "::")
- name (concat "package " name))
- ;; Support nameless packages
- (setq name "package;" package ""))
- (setq end-range
- (save-excursion
- (parse-partial-sexp (point) (point-max) -1) (point))
- ends-ranges (cons end-range ends-ranges)
- packages (cons package packages)))
- (setq is-proto
- (or (eq (following-char) ?\;)
- (eq 0 (get-text-property (point) 'attrib-group)))))
- ;; Skip this function name if it is a prototype declaration.
- (if (and is-proto (not is-pack)) nil
- (or is-pack
- (setq name
- (buffer-substring (match-beginning 8) (match-end 8)))
- (set-text-properties 0 (length name) nil name))
- (setq marker (make-marker))
- (set-marker marker (match-end (if is-pack 2 8)))
- (cond (is-pack nil)
- ((string-match "[:']" name)
- (setq meth t))
- ((> p end-range) nil)
- (t
- (setq name (concat package name) meth t)))
- (setq index (cons name marker))
- (if is-pack
- (push index index-pack-alist)
- (push index index-alist))
- (if meth (push index index-meth-alist))
- (push index index-unsorted-alist)))
- ((match-beginning 16) ; POD section
- (setq name (buffer-substring (match-beginning 17) (match-end 17))
- marker (make-marker))
- (set-marker marker (match-beginning 17))
- (set-text-properties 0 (length name) nil name)
- (setq name (concat (make-string
- (* 3 (- (char-after (match-beginning 16)) ?1))
- ?\ )
- name)
- index (cons name marker))
- (setq index1 (cons (concat "=" name) (cdr index)))
- (push index index-pod-alist)
- (push index1 index-unsorted-alist)))))
+ ((nth 3 state) nil) ; matched in a string, so skip
+ ((match-string 1) ; found a package name!
+ (unless (nth 4 state) ; skip if in a comment
+ (setq name (match-string-no-properties 1)
+ marker (copy-marker (match-end 1)))
+ (if (string= (match-string 3) ";")
+ (setq current-package name) ; package NAME;
+ ;; No semicolon, therefore we have: package NAME BLOCK.
+ ;; Stash the current package, because we need to restore
+ ;; it after the end of BLOCK.
+ (push current-package-end package-stack)
+ (push current-package package-stack)
+ ;; record the current name and its scope
+ (setq current-package name)
+ (setq current-package-end (save-excursion
+ (goto-char (match-beginning 3))
+ (forward-sexp)
+ (point)))
+ (push (cons name marker) index-package-alist)
+ (push (cons (concat "package " name) marker)
index-unsorted-alist))))
+ ((match-string 5) ; found a sub name!
+ (unless (nth 4 state) ; skip if in a comment
+ (setq name (match-string-no-properties 5)
+ marker (copy-marker (match-end 5)))
+ ;; Qualify the sub name with the package if it doesn't
+ ;; already have one, and if it isn't lexically scoped.
+ ;; "my" and "state" subs are lexically scoped, but "our"
+ ;; are just lexical aliases to package subs.
+ (if (and (null (string-match "::" name))
+ (or (null (match-string 4))
+ (string-equal (match-string 4) "our")))
+ (setq name (concat current-package "::" name)))
+ (let ((index (cons name marker)))
+ (push index index-alist)
+ (push index index-sub-alist)
+ (push index index-unsorted-alist))))
+ ((match-string 6) ; found a POD heading!
+ (when (get-text-property (match-beginning 6) 'in-pod)
+ (setq name (concat (make-string
+ (* 3 (- (char-after (match-beginning 6)) ?1))
+ ?\ )
+ (match-string-no-properties 7))
+ marker (copy-marker (match-beginning 7)))
+ (push (cons name marker) index-pod-alist)
+ (push (cons (concat "=" name) marker) index-unsorted-alist)))
+ (t (error "Unidentified match: %s" (match-string 0))))))
+ ;; Now format the collected stuff
(setq index-alist
(if (default-value 'imenu-sort-function)
(sort index-alist (default-value 'imenu-sort-function))
@@ -5307,14 +5369,14 @@ indentation and initial hashes. Behaves usually
outside of comment."
(push (cons "+POD headers+..."
(nreverse index-pod-alist))
index-alist))
- (and (or index-pack-alist index-meth-alist)
- (let ((lst index-pack-alist) hier-list pack elt group name)
- ;; Remove "package ", reverse and uniquify.
+ (and (or index-package-alist index-sub-alist)
+ (let ((lst index-package-alist) hier-list pack elt group name)
+ ;; reverse and uniquify.
(while lst
- (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8))
+ (setq elt (car lst) lst (cdr lst) name (car elt))
(if (assoc name hier-list) nil
(setq hier-list (cons (cons name (cdr elt)) hier-list))))
- (setq lst index-meth-alist)
+ (setq lst index-sub-alist)
(while lst
(setq elt (car lst) lst (cdr lst))
(cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt))
@@ -5342,17 +5404,18 @@ indentation and initial hashes. Behaves usually
outside of comment."
(push (cons "+Hierarchy+..."
hier-list)
index-alist)))
- (and index-pack-alist
+ (and index-package-alist
(push (cons "+Packages+..."
- (nreverse index-pack-alist))
+ (nreverse index-package-alist))
index-alist))
- (and (or index-pack-alist index-pod-alist
+ (and (or index-package-alist index-pod-alist
(default-value 'imenu-sort-function))
index-unsorted-alist
(push (cons "+Unsorted List+..."
(nreverse index-unsorted-alist))
index-alist))
- (cperl-imenu-addback index-alist)))
+ ;; Finally, return the whole collection
+ index-alist))
;; Suggested by Mark A. Hershberger
@@ -5415,120 +5478,79 @@ indentation and initial hashes. Behaves usually
outside of comment."
(cons
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; FIXME: Use regexp-opt.
- (mapconcat
- #'identity
+ (regexp-opt
(append
cperl-sub-keywords
'("if" "until" "while" "elsif" "else"
- "given" "when" "default" "break"
- "unless" "for"
- "try" "catch" "finally"
- "foreach" "continue" "exit" "die" "last" "goto" "next"
- "redo" "return" "local" "exec"
- "do" "dump"
- "use" "our"
- "require" "package" "eval" "evalbytes" "my" "state"
- "BEGIN" "END" "CHECK" "INIT" "UNITCHECK"))
- "\\|") ; Flow control
+ "given" "when" "default" "break"
+ "unless" "for"
+ "try" "catch" "finally"
+ "foreach" "continue" "exit" "die" "last" "goto" "next"
+ "redo" "return" "local" "exec"
+ "do" "dump"
+ "use" "our"
+ "require" "package" "eval" "evalbytes" "my" "state"
+ "BEGIN" "END" "CHECK" "INIT" "UNITCHECK"))) ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,|&]"
; In what follows we use `type' style
; for overwritable builtins
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; FIXME: Use regexp-opt.
- ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm"
- ;; "and" "atan2" "bind" "binmode" "bless" "caller"
- ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
- ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
- ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
- ;; "endhostent" "endnetent" "endprotoent" "endpwent"
- ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl"
- ;; "fileno" "flock" "fork" "formline" "ge" "getc"
- ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
- ;; "gethostbyname" "gethostent" "getlogin"
- ;; "getnetbyaddr" "getnetbyname" "getnetent"
- ;; "getpeername" "getpgrp" "getppid" "getpriority"
- ;; "getprotobyname" "getprotobynumber" "getprotoent"
- ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
- ;; "getservbyport" "getservent" "getsockname"
- ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
- ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
- ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt"
- ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
- ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
- ;; "quotemeta" "rand" "read" "readdir" "readline"
- ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
- ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
- ;; "seekdir" "select" "semctl" "semget" "semop" "send"
- ;; "setgrent" "sethostent" "setnetent" "setpgrp"
- ;; "setpriority" "setprotoent" "setpwent" "setservent"
- ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
- ;; "shutdown" "sin" "sleep" "socket" "socketpair"
- ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
- ;; "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite"
"tell"
- ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
- ;; "umask" "unlink" "unpack" "utime" "values" "vec"
- ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
- "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
- "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
- "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
- "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
- "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
- "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
- "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
- "f\\(ileno\\|c\\(ntl\\)?\\|lock\\|or\\(k\\|mline\\)\\)\\|"
- "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
- "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
- "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
-
"ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
- "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
- "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
-
"\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
- "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
- "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
- "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
- "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
- "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
- "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
- "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
- "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
-
"write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\|seek\\)\\|"
- "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
- "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
- "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
- "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
- "x\\(\\|or\\)\\|__\\(FILE\\|LINE\\|PACKAGE\\|SUB\\)__"
- "\\)\\>") 2 'font-lock-type-face)
+ (regexp-opt
+ '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__"
+ "abs" "accept" "alarm" "and" "atan2"
+ "bind" "binmode" "bless" "caller"
+ "chdir" "chmod" "chown" "chr" "chroot" "close"
+ "closedir" "cmp" "connect" "continue" "cos" "crypt"
+ "dbmclose" "dbmopen" "die" "dump" "endgrent"
+ "endhostent" "endnetent" "endprotoent" "endpwent"
+ "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl"
+ "fileno" "flock" "fork" "formline" "ge" "getc"
+ "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
+ "gethostbyname" "gethostent" "getlogin"
+ "getnetbyaddr" "getnetbyname" "getnetent"
+ "getpeername" "getpgrp" "getppid" "getpriority"
+ "getprotobyname" "getprotobynumber" "getprotoent"
+ "getpwent" "getpwnam" "getpwuid" "getservbyname"
+ "getservbyport" "getservent" "getsockname"
+ "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
+ "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
+ "link" "listen" "localtime" "lock" "log" "lstat" "lt"
+ "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
+ "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
+ "quotemeta" "rand" "read" "readdir" "readline"
+ "readlink" "readpipe" "recv" "ref" "rename" "require"
+ "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
+ "seekdir" "select" "semctl" "semget" "semop" "send"
+ "setgrent" "sethostent" "setnetent" "setpgrp"
+ "setpriority" "setprotoent" "setpwent" "setservent"
+ "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
+ "shutdown" "sin" "sleep" "socket" "socketpair"
+ "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
+ "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite"
"tell"
+ "telldir" "time" "times" "truncate" "uc" "ucfirst"
+ "umask" "unlink" "unpack" "utime" "values" "vec"
+ "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"))
+ "\\)\\>")
+ 2 'font-lock-type-face)
;; In what follows we use `other' style
;; for nonoverwritable builtins
- ;; Somehow 's', 'm' are not auto-generated???
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK"
"__END__" "chomp"
- ;; "break" "chop" "default" "defined" "delete" "do" "each" "else"
"elsif"
- ;; "eval" "evalbytes" "exists" "for" "foreach" "format" "given"
"goto"
- ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
- ;; "no" "our" "package" "pop" "pos" "print" "printf" "prototype"
"push"
- ;; "q" "qq" "qw" "qx" "redo" "return" "say" "scalar" "shift"
- ;; "sort" "splice" "split" "state" "study" "sub" "tie" "tr"
- ;; "undef" "unless" "unshift" "untie" "until" "use"
- ;; "when" "while" "y"
-
"AUTOLOAD\\|BEGIN\\|\\(UNIT\\)?CHECK\\|break\\|c\\(atch\\|ho\\(p\\|mp\\)\\)\\|d\\(e\\(f\\(inally\\|ault\\|ined\\)\\|lete\\)\\|"
-
"o\\)\\|DESTROY\\|e\\(ach\\|val\\(bytes\\)?\\|xists\\|ls\\(e\\|if\\)\\)\\|"
-
"END\\|for\\(\\|each\\|mat\\)\\|g\\(iven\\|rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
- "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
-
"p\\(ackage\\|rototype\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
-
"q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(ay\\|pli\\(ce\\|t\\)\\|"
-
"calar\\|t\\(ate\\|udy\\)\\|ub\\|hift\\|ort\\)\\|t\\(ry?\\|ied?\\)\\|"
- "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
- "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added
manually
- "\\|[sm]" ; Added manually
- "\\)\\>")
+ (regexp-opt
+ '("AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK"
+ "__END__" "__DATA__" "break" "catch" "chomp" "chop" "default"
+ "defined" "delete" "do" "each" "else" "elsif" "eval"
+ "evalbytes" "exists" "finally" "for" "foreach" "format"
"given"
+ "goto" "grep" "if" "keys" "last" "local" "m" "map" "my" "next"
+ "no" "our" "package" "pop" "pos" "print" "printf" "prototype"
+ "push" "q" "qq" "qr" "qw" "qx" "redo" "return" "s" "say"
"scalar"
+ "shift" "sort" "splice" "split" "state" "study" "sub" "tie"
+ "tied" "tr" "try" "undef" "unless" "unshift" "untie" "until"
+ "use" "when" "while" "y"))
+ "\\)\\>")
2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted
;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
@@ -6713,9 +6735,7 @@ One may build such TAGS files from CPerl mode menu."
(cperl-tags-treeify to 1)
(setcar (nthcdr 2 cperl-hierarchy)
(cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to))))
- (message "Updating list of classes: done, requesting display...")
- ;;(cperl-imenu-addback (nth 2 cperl-hierarchy))
- ))
+ (message "Updating list of classes: done, requesting display...")))
(or (nth 2 cperl-hierarchy)
(error "No items found"))
(setq update
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index b2c2e8d..6602a79 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -53,8 +53,7 @@
(defcustom cpp-config-file (convert-standard-filename ".cpp.el")
"File name to save cpp configuration."
- :type 'file
- :group 'cpp)
+ :type 'file)
(define-widget 'cpp-face 'lazy
"Either a face or the special symbol `invisible'."
@@ -62,13 +61,11 @@
(defcustom cpp-known-face 'invisible
"Face used for known cpp symbols."
- :type 'cpp-face
- :group 'cpp)
+ :type 'cpp-face)
(defcustom cpp-unknown-face 'highlight
"Face used for unknown cpp symbols."
- :type 'cpp-face
- :group 'cpp)
+ :type 'cpp-face)
(defcustom cpp-face-type 'light
"Indicate what background face type you prefer.
@@ -76,18 +73,15 @@ Can be either light or dark for color screens, mono for
monochrome
screens, and none if you don't use a window system and don't have
a color-capable display."
:options '(light dark mono nil)
- :type 'symbol
- :group 'cpp)
+ :type 'symbol)
(defcustom cpp-known-writable t
"Non-nil means you are allowed to modify the known conditionals."
- :type 'boolean
- :group 'cpp)
+ :type 'boolean)
(defcustom cpp-unknown-writable t
"Non-nil means you are allowed to modify the unknown conditionals."
- :type 'boolean
- :group 'cpp)
+ :type 'boolean)
(defcustom cpp-edit-list nil
"Alist of cpp macros and information about how they should be displayed.
@@ -101,15 +95,13 @@ Each entry is a list with the following elements:
(cpp-face :tag "False")
(choice (const :tag "True branch writable" t)
(const :tag "False branch writable" nil)
- (const :tag "Both branches writable" both))))
- :group 'cpp)
+ (const :tag "Both branches writable" both)))))
(defcustom cpp-message-min-time-interval 1.0
"Minimum time interval in seconds for `cpp-progress-message' messages.
If nil, `cpp-progress-message' prints no progress messages."
:type '(choice (const :tag "Disable progress messages" nil)
float)
- :group 'cpp
:version "26.1")
(defvar-local cpp-overlay-list nil
@@ -153,36 +145,31 @@ or a cons cell (background-color . COLOR)."
:value-type (choice face
(const invisible)
(cons (const background-color)
- (string :tag "Color"))))
- :group 'cpp)
+ (string :tag "Color")))))
(defcustom cpp-face-light-name-list
'("light gray" "light blue" "light cyan" "light yellow" "light pink"
"pale green" "beige" "orange" "magenta" "violet" "medium purple"
"turquoise")
"Background colors useful with dark foreground colors."
- :type '(repeat string)
- :group 'cpp)
+ :type '(repeat string))
(defcustom cpp-face-dark-name-list
'("dim gray" "blue" "cyan" "yellow" "red"
"dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple"
"dark turquoise")
"Background colors useful with light foreground colors."
- :type '(repeat string)
- :group 'cpp)
+ :type '(repeat string))
(defcustom cpp-face-light-list nil
"Alist of names and faces to be used for light backgrounds."
:type '(repeat (cons string (choice face
- (cons (const background-color) string))))
- :group 'cpp)
+ (cons (const background-color)
string)))))
(defcustom cpp-face-dark-list nil
"Alist of names and faces to be used for dark backgrounds."
:type '(repeat (cons string (choice face
- (cons (const background-color) string))))
- :group 'cpp)
+ (cons (const background-color)
string)))))
(defcustom cpp-face-mono-list
'(("bold" . bold)
@@ -190,15 +177,13 @@ or a cons cell (background-color . COLOR)."
("italic" . italic)
("underline" . underline))
"Alist of names and faces to be used for monochrome screens."
- :type '(repeat (cons string face))
- :group 'cpp)
+ :type '(repeat (cons string face)))
(defcustom cpp-face-none-list
'(("default" . default)
("invisible" . invisible))
"Alist of names and faces available even if you don't use a window system."
- :type '(repeat (cons string cpp-face))
- :group 'cpp)
+ :type '(repeat (cons string cpp-face)))
(defvar cpp-face-all-list
(append cpp-face-light-list
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 042030d..63b344b 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -128,8 +128,7 @@ on one of three forms:
See variable `cwarn-font-lock-feature-keywords-alist' for available
features."
- :type '(repeat sexp)
- :group 'cwarn)
+ :type '(repeat sexp))
(defcustom cwarn-font-lock-feature-keywords-alist
'((assign . cwarn-font-lock-assignment-keywords)
@@ -142,15 +141,13 @@ keyword list."
:type '(alist :key-type (choice (const assign)
(const semicolon)
(const reference))
- :value-type (sexp :tag "Value"))
- :group 'cwarn)
+ :value-type (sexp :tag "Value")))
(defcustom cwarn-verbose t
"When nil, CWarn mode will not generate any messages.
Currently, messages are generated when the mode is activated and
deactivated."
- :group 'cwarn
:type 'boolean)
(defcustom cwarn-mode-text " CWarn"
@@ -158,13 +155,11 @@ deactivated."
\(When the string is not empty, make sure that it has a leading space.)"
:tag "CWarn mode text" ; To separate it from `global-...'
- :group 'cwarn
:type 'string)
(defcustom cwarn-load-hook nil
"Functions to run when CWarn mode is first loaded."
:tag "Load Hook"
- :group 'cwarn
:type 'hook)
(make-obsolete-variable 'cwarn-load-hook
"use `with-eval-after-load' instead." "28.1")
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 8943d8b..4a8a20a 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -97,8 +97,7 @@ dcl-block-begin-regexp and dcl-block-end-regexp.
The meaning of this variable may be changed if
dcl-calc-command-indent-function is set to a function."
- :type 'integer
- :group 'dcl)
+ :type 'integer)
(defcustom dcl-continuation-offset 6
@@ -107,8 +106,7 @@ A continuation line is a line that follows a line ending
with `-'.
The meaning of this variable may be changed if
dcl-calc-cont-indent-function is set to a function."
- :type 'integer
- :group 'dcl)
+ :type 'integer)
(defcustom dcl-margin-offset 8
@@ -117,37 +115,32 @@ The first command line in a file or after a SUBROUTINE
statement is indented
this much. Other command lines are indented the same number of columns as
the preceding command line.
A command line is a line that starts with `$'."
- :type 'integer
- :group 'dcl)
+ :type 'integer)
(defcustom dcl-margin-label-offset 2
"Number of columns to indent a margin label in DCL.
A margin label is a label that doesn't begin or end a block, i.e. it
doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
- :type 'integer
- :group 'dcl)
+ :type 'integer)
(defcustom dcl-comment-line-regexp "^\\$!"
"Regexp describing the start of a comment line in DCL.
Comment lines are not indented."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-block-begin-regexp "loop[0-9]*:"
"Regexp describing a command that begins an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-block-end-regexp "endloop[0-9]*:"
"Regexp describing a command that ends an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-calc-command-indent-function nil
@@ -178,8 +171,7 @@ CUR-INDENT + EXTRA-INDENT.
This package includes two functions suitable for this:
dcl-calc-command-indent-multiple
dcl-calc-command-indent-hang"
- :type '(choice (const nil) function)
- :group 'dcl)
+ :type '(choice (const nil) function))
(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
@@ -196,8 +188,7 @@ CUR-INDENT + EXTRA-INDENT.
This package includes one function suitable for this:
dcl-calc-cont-indent-relative"
- :type 'function
- :group 'dcl)
+ :type 'function)
(defcustom dcl-tab-always-indent t
@@ -206,50 +197,41 @@ If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left margin.
Data lines (i.e. lines not part of a command line or continuation line) are
never indented."
- :type 'boolean
- :group 'dcl)
+ :type 'boolean)
(defcustom dcl-electric-characters t
"Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
- :type 'boolean
- :group 'dcl)
+ :type 'boolean)
(defcustom dcl-tempo-comma ", "
"Text to insert when a comma is needed in a template, in DCL mode."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-tempo-left-paren "("
"Text to insert when a left parenthesis is needed in a template in DCL."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-tempo-right-paren ")"
"Text to insert when a right parenthesis is needed in a template in DCL."
- :type 'string
- :group 'dcl)
+ :type 'string)
; I couldn't decide what looked best, so I'll let you decide...
; Remember, you can also customize this with imenu-submenu-name-format.
(defcustom dcl-imenu-label-labels "Labels"
"Imenu menu title for sub-listing with label names."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-goto "GOTO"
"Imenu menu title for sub-listing with GOTO statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-gosub "GOSUB"
"Imenu menu title for sub-listing with GOSUB statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-call "CALL"
"Imenu menu title for sub-listing with CALL statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-generic-expression
`((nil "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):[ \t]+SUBROUTINE\\b" 1)
@@ -263,14 +245,12 @@ never indented."
The default includes SUBROUTINE labels in the main listing and
sub-listings for other labels, CALL, GOTO and GOSUB statements.
See `imenu-generic-expression' for details."
- :type '(repeat (sexp :tag "Imenu Expression"))
- :group 'dcl)
+ :type '(repeat (sexp :tag "Imenu Expression")))
(defcustom dcl-mode-hook nil
"Hook called by `dcl-mode'."
- :type 'hook
- :group 'dcl)
+ :type 'hook)
;;; *** Global variables ****************************************************
@@ -354,16 +334,14 @@ See `imenu-generic-expression' for details."
"Regular expression describing white space in a DCL command line.
White space is any number of continued lines with only space,tab,endcomment
followed by space or tab."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-label-r
"[a-zA-Z0-9_$]*:\\([ \t!]\\|$\\)"
"Regular expression describing a label.
A label is a name followed by a colon followed by white-space or end-of-line."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-cmd-r
@@ -373,8 +351,7 @@ A line starting with $, optionally followed by continuation
lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-command-regexp
@@ -384,8 +361,7 @@ A line starting with $, optionally followed by continuation
lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-electric-reindent-regexps
@@ -397,8 +373,7 @@ is defined as dcl-electric-character.
E.g.: if this list contains `endif', the key `f' is defined as
dcl-electric-character and you have just typed the `f' in
`endif', the line will be reindented."
- :type '(repeat regexp)
- :group 'dcl)
+ :type '(repeat regexp))
(defvar dcl-option-alist
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index fa5724a..85e9b4b 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -54,41 +54,31 @@
"Base functionality for executable interpreter scripts."
:group 'processes)
-;; This used to default to `other', but that doesn't seem to have any
-;; significance. fx 2000-02-11.
-(defcustom executable-insert t ; 'other
+(defcustom executable-insert t
"Non-nil means offer to add a magic number to a file.
This takes effect when you switch to certain major modes,
including Shell-script mode (`sh-mode').
When you type \\[executable-set-magic], it always offers to add or
update the magic number."
-;;; :type '(choice (const :tag "off" nil)
-;;; (const :tag "on" t)
-;;; symbol)
- :type 'boolean
- :group 'executable)
-
+ :type 'boolean)
(defcustom executable-query 'function
"If non-nil, ask user before changing an existing magic number.
When this is `function', only ask when called non-interactively."
:type '(choice (const :tag "Don't Ask" nil)
(const :tag "Ask when non-interactive" function)
- (other :tag "Ask" t))
- :group 'executable)
+ (other :tag "Ask" t)))
(defcustom executable-magicless-file-regexp
"/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
"On files with this kind of name no magic is inserted or changed."
- :type 'regexp
- :group 'executable)
+ :type 'regexp)
(defcustom executable-prefix "#!"
"Interpreter magic number prefix inserted when there was no magic number.
Use of `executable-prefix-env' is preferable to this option."
:version "26.1" ; deprecated
- :type 'string
- :group 'executable)
+ :type 'string)
(defcustom executable-prefix-env nil
"If non-nil, use \"/usr/bin/env\" in interpreter magic number.
@@ -96,8 +86,7 @@ If this variable is non-nil, the interpreter magic number
inserted
by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\",
otherwise it will be \"#!/path/to/INTERPRETER\"."
:version "26.1"
- :type 'boolean
- :group 'executable)
+ :type 'boolean)
(defcustom executable-chmod 73
"After saving, if the file is not executable, set this mode.
@@ -105,8 +94,7 @@ This mode passed to `set-file-modes' is taken absolutely
when negative, or
relative to the files existing modes. Do nothing if this is nil.
Typical values are 73 (+x) or -493 (rwxr-xr-x)."
:type '(choice integer
- (const nil))
- :group 'executable)
+ (const nil)))
(defvar executable-command nil)
@@ -114,8 +102,7 @@ Typical values are 73 (+x) or -493 (rwxr-xr-x)."
(defcustom executable-self-display "tail"
"Command you use with argument `-n+2' to make text files self-display.
Note that the like of `more' doesn't work too well under Emacs \\[shell]."
- :type 'string
- :group 'executable)
+ :type 'string)
(make-obsolete-variable 'executable-self-display nil "25.1" 'set)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5d96c62..b8c8a82 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1198,7 +1198,6 @@ default) no filter is applied."
'(" " flymake-mode-line-title flymake-mode-line-exception
flymake-mode-line-counters)
"Mode line construct for customizing Flymake information."
- :group 'flymake
:type '(repeat (choice string symbol)))
(defcustom flymake-mode-line-counter-format
@@ -1210,7 +1209,6 @@ default) no filter is applied."
This is a suitable place for placing the `flymake-error-counter',
`flymake-warning-counter' and `flymake-note-counter' constructs.
Separating each of these with space is not necessary."
- :group 'flymake
:type '(repeat (choice string symbol)))
(defvar flymake-mode-line-title '(:eval (flymake--mode-line-title))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index eb114ac..b105cba 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -64,8 +64,7 @@ pdb (Python), and jdb."
(defcustom gud-key-prefix "\C-x\C-a"
"Prefix of all GUD commands valid in C buffers."
- :type 'key-sequence
- :group 'gud)
+ :type 'key-sequence)
(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack
@@ -1074,8 +1073,7 @@ The file names should be absolute, or relative to the
directory
containing the executable being debugged."
:type '(choice (const :tag "Current Directory" nil)
(repeat :value ("")
- directory))
- :group 'gud)
+ directory)))
(defun gud-dbx-massage-args (_file args)
(nconc (let ((directories gud-dbx-directories)
@@ -1380,8 +1378,7 @@ The file names should be absolute, or relative to the
directory
containing the executable being debugged."
:type '(choice (const :tag "Current Directory" nil)
(repeat :value ("")
- directory))
- :group 'gud)
+ directory)))
(defun gud-xdb-massage-args (_file args)
(nconc (let ((directories gud-xdb-directories)
@@ -1563,8 +1560,7 @@ into one that invokes an Emacs-enabled debugging session.
(defcustom gud-perldb-command-name "perl -d"
"Default command to execute a Perl script under debugger."
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun perldb (command-line)
@@ -1677,8 +1673,7 @@ and source-file directory for your debugger."
(if (executable-find "pdb") "pdb" "python -m pdb")
"Command that executes the Python debugger."
:version "27.1"
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun pdb (command-line)
@@ -1759,8 +1754,7 @@ directory and source-file directory for your debugger."
"File name for executing the Guile debugger.
This should be an executable on your path, or an absolute file name."
:version "25.1"
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun guiler (command-line)
@@ -1883,8 +1877,7 @@ and source-file directory for your debugger."
(defcustom gud-jdb-command-name "jdb"
"Command that executes the Java debugger."
- :type 'string
- :group 'gud)
+ :type 'string)
(defcustom gud-jdb-use-classpath t
"If non-nil, search for Java source files in classpath directories.
@@ -1899,8 +1892,7 @@ and parsing all Java files for class information.
Set to nil to use `gud-jdb-directories' to scan java sources for
class information on jdb startup (original method)."
- :type 'boolean
- :group 'gud)
+ :type 'boolean)
(defvar gud-jdb-classpath nil
"Java/jdb classpath directories list.
@@ -2584,7 +2576,6 @@ Commands:
(defcustom gud-chdir-before-run t
"Non-nil if GUD should `cd' to the debugged executable."
- :group 'gud
:type 'boolean)
;; Perform initializations common to all debuggers.
@@ -3419,7 +3410,6 @@ Treats actions as defuns."
python-mode)
"List of modes for which to enable GUD tooltips."
:type '(repeat (symbol :tag "Major mode"))
- :group 'gud
:group 'tooltip)
(defcustom gud-tooltip-display
@@ -3431,13 +3421,11 @@ Forms in the list are combined with AND. The default
is to display
only tooltips in the buffer containing the overlay arrow."
:type 'sexp
:risky t
- :group 'gud
:group 'tooltip)
(defcustom gud-tooltip-echo-area nil
"Use the echo area instead of frames for GUD tooltips."
:type 'boolean
- :group 'gud
:group 'tooltip)
(make-obsolete-variable 'gud-tooltip-echo-area
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 73d09e0..81ba0d8 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -232,13 +232,11 @@
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
- :type 'boolean
- :group 'hideshow)
+ :type 'boolean)
(defcustom hs-minor-mode-hook nil
"Hook called when hideshow minor mode is activated or deactivated."
:type 'hook
- :group 'hideshow
:version "21.1")
(defcustom hs-isearch-open 'code
@@ -254,8 +252,7 @@ This has effect only if `search-invisible' is set to
`open'."
:type '(choice (const :tag "open only code blocks" code)
(const :tag "open only comment blocks" comment)
(const :tag "open both code and comment blocks" t)
- (const :tag "don't open any of them" nil))
- :group 'hideshow)
+ (const :tag "don't open any of them" nil)))
;;;###autoload
(defvar hs-special-modes-alist
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index 933cb33..a36f020 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -86,42 +86,35 @@
(defcustom icon-indent-level 4
"Indentation of Icon statements with respect to containing block."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-brace-imaginary-offset 0
"Imagined indentation of an Icon open brace that actually follows a
statement."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-brace-offset 0
"Extra indentation for braces, compared with other text in same context."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-continued-statement-offset 4
"Extra indent for Icon lines not starting new statements."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-continued-brace-offset 0
"Extra indent for Icon substatements that start with open-braces.
This is in addition to `icon-continued-statement-offset'."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-auto-newline nil
"Non-nil means automatically newline before and after braces Icon code.
This applies when braces are inserted."
- :type 'boolean
- :group 'icon)
+ :type 'boolean)
(defcustom icon-tab-always-indent t
"Non-nil means TAB in Icon mode should always reindent the current line.
It will then reindent, regardless of where in the line point is
when the TAB command is used."
- :type 'boolean
- :group 'icon)
+ :type 'boolean)
(defvar icon-imenu-generic-expression
'((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*(" 1))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index ac23059..146ed4d 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -76,8 +76,7 @@
Input matching this regexp is not saved on the input history in Inferior Lisp
mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
\(as in :a, :c, etc.)"
- :type 'regexp
- :group 'inferior-lisp)
+ :type 'regexp)
(defvar inferior-lisp-mode-map
(let ((map (copy-keymap comint-mode-map)))
@@ -155,8 +154,7 @@ mode. Default is whitespace followed by 0 or 1
single-letter colon-keyword
(defcustom inferior-lisp-program "lisp"
"Program name for invoking an inferior Lisp in Inferior Lisp mode."
- :type 'string
- :group 'inferior-lisp)
+ :type 'string)
(defcustom inferior-lisp-load-command "(load \"%s\")\n"
"Format-string for building a Lisp expression to load a file.
@@ -166,8 +164,7 @@ to load that file. The default works acceptably on most
Lisps.
The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
produces cosmetically superior output for this application,
but it works only in Common Lisp."
- :type 'string
- :group 'inferior-lisp)
+ :type 'string)
(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *"
"Regexp to recognize prompts in the Inferior Lisp mode.
@@ -182,8 +179,7 @@ More precise choices:
Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
kcl: \"^>+ *\""
- :type 'regexp
- :group 'inferior-lisp)
+ :type 'regexp)
(defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer.
@@ -487,8 +483,7 @@ describing the last `lisp-load-file' or `lisp-compile-file'
command.")
If it's loaded into a buffer that is in one of these major modes, it's
considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
Used by these commands to determine defaults."
- :type '(repeat symbol)
- :group 'inferior-lisp)
+ :type '(repeat symbol))
(defun lisp-load-file (file-name)
"Load a Lisp file into the inferior Lisp process."
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index cdf6536..21bda08 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -427,22 +427,19 @@ Match group 1 is the name of the macro.")
(defcustom js-indent-level 4
"Number of spaces for each indentation step in `js-mode'."
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
(defcustom js-expr-indent-offset 0
"Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
(defcustom js-paren-indent-offset 0
"Number of additional spaces for indenting expressions in parentheses.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-square-indent-offset 0
@@ -450,7 +447,6 @@ The value must be no less than minus `js-indent-level'."
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-curly-indent-offset 0
@@ -458,7 +454,6 @@ The value must be no less than minus `js-indent-level'."
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-switch-indent-offset 0
@@ -466,26 +461,22 @@ The value must be no less than minus `js-indent-level'."
The value must not be negative."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.4")
(defcustom js-flat-functions nil
"Treat nested functions as top-level functions in `js-mode'.
This applies to function movement, marking, and so on."
- :type 'boolean
- :group 'js)
+ :type 'boolean)
(defcustom js-indent-align-list-continuation t
"Align continuation of non-empty ([{ lines in `js-mode'."
:version "26.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-comment-lineup-func #'c-lineup-C-comments
"Lineup function for `cc-mode-style', for C comments in `js-mode'."
- :type 'function
- :group 'js)
+ :type 'function)
(defcustom js-enabled-frameworks js--available-frameworks
"Frameworks recognized by `js-mode'.
@@ -493,30 +484,26 @@ To improve performance, you may turn off some frameworks
you
seldom use, either globally or on a per-buffer basis."
:type (cons 'set (mapcar (lambda (x)
(list 'const x))
- js--available-frameworks))
- :group 'js)
+ js--available-frameworks)))
(defcustom js-js-switch-tabs
(and (memq system-type '(darwin)) t)
"Whether `js-mode' should display tabs while selecting them.
This is useful only if the windowing system has a good mechanism
for preventing Firefox from stealing the keyboard focus."
- :type 'boolean
- :group 'js)
+ :type 'boolean)
(defcustom js-js-tmpdir
"~/.emacs.d/js/js"
"Temporary directory used by `js-mode' to communicate with Mozilla.
This directory must be readable and writable by both Mozilla and Emacs."
- :type 'directory
- :group 'js)
+ :type 'directory)
(defcustom js-js-timeout 5
"Reply timeout for executing commands in Mozilla via `js-mode'.
The value is given in seconds. Increase this value if you are
getting timeout messages."
- :type 'integer
- :group 'js)
+ :type 'integer)
(defcustom js-indent-first-init nil
"Non-nil means specially indent the first variable declaration's initializer.
@@ -557,8 +544,7 @@ don't indent the first one's initializer; otherwise, indent
it.
bar = 2;"
:version "25.1"
:type '(choice (const nil) (const t) (const dynamic))
- :safe 'symbolp
- :group 'js)
+ :safe 'symbolp)
(defcustom js-chain-indent nil
"Use \"chained\" indentation.
@@ -571,8 +557,7 @@ then the \".\"s will be lined up:
"
:version "26.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-detect-syntax t
"When non-nil, automatically detect whether JavaScript uses JSX.
@@ -581,8 +566,7 @@ t. The detection strategy can be customized by adding
elements
to `js-jsx-regexps', which see."
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-syntax nil
"When non-nil, parse JavaScript with consideration for JSX syntax.
@@ -600,8 +584,7 @@ When `js-mode' is already enabled, you should call
It is set to be buffer-local (and t) when in `js-jsx-mode'."
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-align->-with-< t
"When non-nil, “>” will be indented to the opening “<” in JSX.
@@ -625,8 +608,7 @@ When this is disabled, JSX indentation looks like this:
/>"
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-indent-level nil
"When non-nil, indent JSX by this value, instead of like JS.
@@ -655,8 +637,7 @@ indentation looks like this (different):
:version "27.1"
:type '(choice integer
(const :tag "Not Set" nil))
- :safe (lambda (x) (or (null x) (integerp x)))
- :group 'js)
+ :safe (lambda (x) (or (null x) (integerp x))))
;; This is how indentation behaved out-of-the-box until Emacs 27. JSX
;; indentation was controlled with `sgml-basic-offset', which defaults
;; to 2, whereas `js-indent-level' defaults to 4. Users who had the
@@ -685,8 +666,7 @@ indentation looks like this:
This variable is like `sgml-attribute-offset'."
:version "27.1"
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
;;; KeyMap
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index c4ea8e1..485e64e 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -35,8 +35,7 @@
(defvar ld-script-location-counter-face 'ld-script-location-counter)
(defface ld-script-location-counter
'((t :weight bold :inherit font-lock-builtin-face))
- "Face for location counter in GNU ld script."
- :group 'ld-script)
+ "Face for location counter in GNU ld script.")
;; Syntax rules
(defvar ld-script-mode-syntax-table
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 99f4be3..7dfaed4 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -60,12 +60,34 @@ If m4 is not in your PATH, set this to an absolute file
name."
;;or
;;(defconst m4-program-options '("--prefix-builtins"))
+;; Needed at compile-time for `m4-font-lock-keywords' below.
+(eval-and-compile
+ (defconst m4--macro-list
+ ;; From (info "(m4) Macro index")
+ '("__file__" "__gnu__" "__line__" "__os2__" "__program__" "__unix__"
+ "__windows__" "argn" "array" "array_set" "builtin" "capitalize"
+ "changecom" "changequote" "changeword" "cleardivert" "cond" "copy"
+ "curry" "debugfile" "debugmode" "decr" "define" "define_blind"
+ "defn" "divert" "divnum" "dnl" "downcase" "dquote" "dquote_elt"
+ "dumpdef" "errprint" "esyscmd" "eval" "example" "exch"
+ "fatal_error" "file" "foreach" "foreachq" "forloop" "format" "gnu"
+ "ifdef" "ifelse" "include" "incr" "index" "indir" "join" "joinall"
+ "len" "line" "m4exit" "m4wrap" "maketemp" "mkstemp" "nargs" "os2"
+ "patsubst" "popdef" "pushdef" "quote" "regexp" "rename" "reverse"
+ "shift" "sinclude" "stack_foreach" "stack_foreach_lifo"
+ "stack_foreach_sep" "stack_foreach_sep_lifo" "substr" "syscmd"
+ "sysval" "traceoff" "traceon" "translit" "undefine" "undivert"
+ "unix" "upcase" "windows")
+ "List of valid m4 macros for M4 mode."))
+
(defvar m4-font-lock-keywords
- '(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t))
- ("\\$[*#@0-9]" . font-lock-variable-name-face)
- ("\\$@" . font-lock-variable-name-face)
- ("\\$\\*" . font-lock-variable-name-face)
-
("\\_<\\(m4_\\)?\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|iv
[...]
+ (eval-when-compile
+ `(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t))
+ ("\\$[*#@0-9]" . font-lock-variable-name-face)
+ ("\\$@" . font-lock-variable-name-face)
+ ("\\$\\*" . font-lock-variable-name-face)
+ (,(concat "\\_<\\(m4_\\)?" (regexp-opt m4--macro-list) "\\_>")
+ . font-lock-keyword-face)))
"Default `font-lock-keywords' for M4 mode.")
(defcustom m4-mode-hook nil
@@ -155,22 +177,4 @@ If m4 is not in your PATH, set this to an absolute file
name."
;;stuff to play with for debugging
;(char-to-string (char-syntax ?`))
-;;;how I generate the nasty looking regexps at the top
-;;;(make-regexp '("builtin" "changecom" "changequote" "changeword" "debugfile"
-;;; "debugmode" "decr" "define" "defn" "divert" "divnum" "dnl"
-;;; "dumpdef" "errprint" "esyscmd" "eval" "file" "format" "gnu"
-;;; "ifdef" "ifelse" "include" "incr" "index" "indir" "len" "line"
-;;; "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef"
"regexp"
-;;; "shift" "sinclude" "substr" "syscmd" "sysval" "traceoff"
"traceon"
-;;; "translit" "undefine" "undivert" "unix"))
-;;;(make-regexp '("m4_builtin" "m4_changecom" "m4_changequote" "m4_changeword"
-;;; "m4_debugfile" "m4_debugmode" "m4_decr" "m4_define" "m4_defn"
-;;; "m4_divert" "m4_divnum" "m4_dnl" "m4_dumpdef" "m4_errprint"
-;;; "m4_esyscmd" "m4_eval" "m4_file" "m4_format" "m4_ifdef"
"m4_ifelse"
-;;; "m4_include" "m4_incr" "m4_index" "m4_indir" "m4_len"
"m4_line"
-;;; "m4_m4exit" "m4_m4wrap" "m4_maketemp" "m4_patsubst"
"m4_popdef"
-;;; "m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude" "m4_substr"
-;;; "m4_syscmd" "m4_sysval" "m4_traceoff" "m4_traceon"
"m4_translit"
-;;; "m4_m4_undefine" "m4_undivert"))
-
;;; m4-mode.el ends here
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index e382d6e..3d1e7d6 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -101,14 +101,12 @@
(defface makefile-space
'((((class color)) (:background "hotpink"))
(t (:reverse-video t)))
- "Face to use for highlighting leading spaces in Font-Lock mode."
- :group 'makefile)
+ "Face to use for highlighting leading spaces in Font-Lock mode.")
(defface makefile-targets
;; This needs to go along both with foreground and background colors (i.e.
shell)
'((t (:inherit font-lock-function-name-face)))
"Face to use for additionally highlighting rule targets in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defface makefile-shell
@@ -116,7 +114,6 @@
;;'((((class color) (min-colors 88) (background light)) (:background
"seashell1"))
;; (((class color) (min-colors 88) (background dark)) (:background
"seashell4")))
"Face to use for additionally highlighting Shell commands in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defface makefile-makepp-perl
@@ -124,19 +121,16 @@
(((class color) (background dark)) (:background "DarkBlue"))
(t (:reverse-video t)))
"Face to use for additionally highlighting Perl code in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defcustom makefile-browser-buffer-name "*Macros and Targets*"
"Name of the macro- and target browser buffer."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-target-colon ":"
"String to append to all target names inserted by `makefile-insert-target'.
\":\" or \"::\" are common values."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-macro-assign " = "
"String to append to all macro names inserted by `makefile-insert-macro'.
@@ -144,70 +138,58 @@ The normal value should be \" = \", since this is what
standard make expects. However, newer makes such as dmake
allow a larger variety of different macro assignments, so you
might prefer to use \" += \" or \" := \" ."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-electric-keys nil
"If non-nil, Makefile mode should install electric keybindings.
Default is nil."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-use-curly-braces-for-macros-p nil
"Controls the style of generated macro references.
Non-nil means macro references should use curly braces, like `${this}'.
nil means use parentheses, like `$(this)'."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-tab-after-target-colon t
"If non-nil, insert a TAB after a target colon.
Otherwise, a space is inserted.
The default is t."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-browser-leftmost-column 10
"Number of blanks to the left of the browser selection mark."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-browser-cursor-column 10
"Column the cursor goes to when it moves up or down in the Makefile browser."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-backslash-column 48
"Column in which `makefile-backslash-region' inserts backslashes."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-backslash-align t
"If non-nil, `makefile-backslash-region' will align backslashes."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-browser-selected-mark "+ "
"String used to mark selected entries in the Makefile browser."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-browser-unselected-mark " "
"String used to mark unselected entries in the Makefile browser."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-browser-auto-advance-after-selection-p t
"If non-nil, cursor will move after item is selected in Makefile browser."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-pickup-everything-picks-up-filenames-p nil
"If non-nil, `makefile-pickup-everything' picks up filenames as targets.
This means it calls `makefile-pickup-filenames-as-targets'.
Otherwise filenames are omitted."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-cleanup-continuations nil
"If non-nil, automatically clean up continuation lines when saving.
@@ -215,13 +197,11 @@ A line is cleaned up by removing all whitespace following
a trailing
backslash. This is done silently.
IMPORTANT: Please note that enabling this option causes Makefile mode
to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-mode-hook nil
"Normal hook run by `makefile-mode'."
- :type 'hook
- :group 'makefile)
+ :type 'hook)
(defvar makefile-browser-hook '())
@@ -240,8 +220,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems
necessary\"."
"List of special targets.
You will be offered to complete on one of those in the minibuffer whenever
you enter a \".\" at the beginning of a line in `makefile-mode'."
- :type '(repeat string)
- :group 'makefile)
+ :type '(repeat string))
(put 'makefile-special-targets-list 'risky-local-variable t)
(defcustom makefile-runtime-macros-list
@@ -250,8 +229,7 @@ you enter a \".\" at the beginning of a line in
`makefile-mode'."
If you insert a macro reference using `makefile-insert-macro-ref', the name
of the macro is checked against this list. If it can be found its name will
not be enclosed in { } or ( )."
- :type '(repeat (list string))
- :group 'makefile)
+ :type '(repeat (list string)))
;; Note that the first big subexpression is used by font lock. Note
;; that if you change this regexp you might have to fix the imenu
@@ -563,8 +541,7 @@ not be enclosed in { } or ( )."
(defcustom makefile-brave-make "make"
"How to invoke make, for `makefile-query-targets'.
This should identify a `make' command that can handle the `-q' option."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defvaralias 'makefile-query-one-target-method
'makefile-query-one-target-method-function)
@@ -584,13 +561,11 @@ The function must satisfy this calling convention:
* It must return the integer value 0 (zero) if the given target
should be considered up-to-date in the context of the given
makefile, any nonzero integer value otherwise."
- :type 'function
- :group 'makefile)
+ :type 'function)
(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
"Name of the Up-to-date overview buffer."
- :type 'string
- :group 'makefile)
+ :type 'string)
;;; --- end of up-to-date-overview configuration ------------------
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 9da968c..46b0949 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -109,44 +109,31 @@
"\\(def\\|let\\|mode_def\\|vardef\\)")
(macro-keywords-2
"\\(primarydef\\|secondarydef\\|tertiarydef\\)")
-;(make-regexp
-; '("expr" "suffix" "text" "primary" "secondary" "tertiary") t)
(args-keywords
- (concat "\\(expr\\|primary\\|s\\(econdary\\|uffix\\)\\|"
- "te\\(rtiary\\|xt\\)\\)"))
-;(make-regexp
-; '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
-; "string" "transform" "newinternal") t)
+ (eval-when-compile
+ (regexp-opt
+ '("expr" "suffix" "text" "primary" "secondary" "tertiary")
+ t)))
(type-keywords
- (concat "\\(boolean\\|color\\|n\\(ewinternal\\|umeric\\)\\|"
- "p\\(a\\(ir\\|th\\)\\|en\\|icture\\)\\|string\\|"
- "transform\\)"))
-;(make-regexp
-; '("for" "forever" "forsuffixes" "endfor"
-; "step" "until" "upto" "downto" "thru" "within"
-; "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
-; "let" "def" "vardef" "enddef" "mode_def"
-; "true" "false" "known" "unknown" "and" "or" "not"
-; "save" "interim" "inner" "outer" "relax"
-; "begingroup" "endgroup" "expandafter" "scantokens"
-; "generate" "input" "endinput" "end" "bye"
-; "message" "errmessage" "errhelp" "special" "numspecial"
-; "readstring" "readfrom" "write") t)
+ (eval-when-compile
+ (regexp-opt
+ '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
+ "string" "transform" "newinternal")
+ t)))
(syntactic-keywords
- (concat "\\(and\\|b\\(egingroup\\|ye\\)\\|"
- "d\\(ef\\|ownto\\)\\|e\\(lse\\(\\|if\\)"
- "\\|nd\\(\\|def\\|for\\|group\\|input\\)"
- "\\|rr\\(help\\|message\\)"
- "\\|x\\(it\\(if\\|unless\\)\\|pandafter\\)\\)\\|"
- "f\\(alse\\|i\\|or\\(\\|ever\\|suffixes\\)\\)\\|"
- "generate\\|i\\(ff?\\|n\\(ner\\|put\\|terim\\)\\)\\|"
- "known\\|let\\|m\\(essage\\|ode_def\\)\\|"
- "n\\(ot\\|umspecial\\)\\|o\\(r\\|uter\\)\\|"
- "re\\(ad\\(from\\|string\\)\\|lax\\)\\|"
- "s\\(ave\\|cantokens\\|pecial\\|tep\\)\\|"
- "t\\(hru\\|rue\\)\\|"
- "u\\(n\\(known\\|til\\)\\|pto\\)\\|"
- "vardef\\|w\\(ithin\\|rite\\)\\)"))
+ (eval-when-compile
+ (regexp-opt
+ '("for" "forever" "forsuffixes" "endfor"
+ "step" "until" "upto" "downto" "thru" "within"
+ "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
+ "let" "def" "vardef" "enddef" "mode_def"
+ "true" "false" "known" "unknown" "and" "or" "not"
+ "save" "interim" "inner" "outer" "relax"
+ "begingroup" "endgroup" "expandafter" "scantokens"
+ "generate" "input" "endinput" "end" "bye"
+ "message" "errmessage" "errhelp" "special" "numspecial"
+ "readstring" "readfrom" "write")
+ t)))
)
(list
;; embedded TeX code in btex ... etex
@@ -463,25 +450,21 @@ If the list was changed, sort the list and remove
duplicates first."
(defcustom meta-indent-level 2
"Indentation of begin-end blocks in Metafont or MetaPost mode."
- :type 'integer
- :group 'meta-font)
+ :type 'integer)
(defcustom meta-left-comment-regexp "%%+"
"Regexp matching comments that should be placed on the left margin."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-right-comment-regexp nil
"Regexp matching comments that should be placed on the right margin."
:type '(choice regexp
- (const :tag "None" nil))
- :group 'meta-font)
+ (const :tag "None" nil)))
(defcustom meta-ignore-comment-regexp "%[^%]"
"Regexp matching comments whose indentation should not be touched."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-begin-environment-regexp
@@ -489,22 +472,19 @@ If the list was changed, sort the list and remove
duplicates first."
"def\\|for\\(\\|ever\\|suffixes\\)\\|if\\|mode_def\\|"
"primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)")
"Regexp matching the beginning of environments to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-end-environment-regexp
(concat "\\(end\\(char\\|def\\|f\\(ig\\|or\\)\\|gr\\(aph\\|oup\\)\\)"
"\\|fi\\)")
"Regexp matching the end of environments to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-within-environment-regexp
; (concat "\\(e\\(lse\\(\\|if\\)\\|xit\\(if\\|unless\\)\\)\\)")
(concat "\\(else\\(\\|if\\)\\)")
"Regexp matching keywords within environments not to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defun meta-comment-indent ()
@@ -689,14 +669,12 @@ If the list was changed, sort the list and remove
duplicates first."
(concat "\\(begin\\(char\\|fig\\|logochar\\)\\|def\\|mode_def\\|"
"primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)")
"Regexp matching beginning of defuns in Metafont or MetaPost mode."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-end-defun-regexp
(concat "\\(end\\(char\\|def\\|fig\\)\\)")
"Regexp matching the end of defuns in Metafont or MetaPost mode."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defun meta-beginning-of-defun (&optional arg)
@@ -893,24 +871,21 @@ The environment marked is the one that contains point or
follows point."
(defcustom meta-mode-load-hook nil
"Hook evaluated when first loading Metafont or MetaPost mode."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
(make-obsolete-variable 'meta-mode-load-hook
"use `with-eval-after-load' instead." "28.1")
(defcustom meta-common-mode-hook nil
"Hook evaluated by both `metafont-mode' and `metapost-mode'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
(defcustom metafont-mode-hook nil
"Hook evaluated by `metafont-mode' after `meta-common-mode-hook'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
+
(defcustom metapost-mode-hook nil
"Hook evaluated by `metapost-mode' after `meta-common-mode-hook'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index a77a4e2..536d3be 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -51,23 +51,19 @@
(defcustom m2-compile-command "m2c"
"Command to compile Modula-2 programs."
- :type 'string
- :group 'modula2)
+ :type 'string)
(defcustom m2-link-command "m2l"
"Command to link Modula-2 programs."
- :type 'string
- :group 'modula2)
+ :type 'string)
(defcustom m2-link-name nil
"Name of the Modula-2 executable."
- :type '(choice (const nil) string)
- :group 'modula2)
+ :type '(choice (const nil) string))
(defcustom m2-end-comment-column 75
"Column for aligning the end of a comment, in Modula-2."
- :type 'integer
- :group 'modula2)
+ :type 'integer)
;;; Added by TEP
(defvar m2-mode-map
@@ -105,8 +101,7 @@
(defcustom m2-indent 5
"This variable gives the indentation in Modula-2 mode."
- :type 'integer
- :group 'modula2)
+ :type 'integer)
(put 'm2-indent 'safe-local-variable
(lambda (v) (or (null v) (integerp v))))
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index ddcc6f5..a8a8647 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -215,9 +215,15 @@ newline or semicolon after an else or end keyword."
(concat "[^#%\n]*\\(" octave-continuation-marker-regexp
"\\)\\s-*\\(\\s<.*\\)?$"))
-;; Char \ is considered a bad decision for continuing a line.
(defconst octave-continuation-string "..."
- "Character string used for Octave continuation lines.")
+ "Character string used for Octave continuation lines.
+Joins current line with following line, except within
+double-quoted strings, where `octave-string-continuation-marker'
+is used instead.")
+
+(defconst octave-string-continuation-marker "\\"
+ "Line continuation marker for double-quoted Octave strings.
+Non-string statements use `octave-continuation-string'.")
(defvar octave-mode-imenu-generic-expression
(list
@@ -1032,11 +1038,11 @@ directory and makes this the current buffer's default
directory."
(looking-at regexp)))
(defun octave-maybe-insert-continuation-string ()
- (if (or (octave-in-comment-p)
- (save-excursion
- (beginning-of-line)
- (looking-at octave-continuation-regexp)))
- nil
+ (declare (obsolete nil "28.1"))
+ (unless (or (octave-in-comment-p)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at octave-continuation-regexp)))
(delete-horizontal-space)
(insert (concat " " octave-continuation-string))))
@@ -1218,23 +1224,22 @@ q: Don't fix\n" func file))
(defun octave-indent-new-comment-line (&optional soft)
"Break Octave line at point, continuing comment if within one.
Insert `octave-continuation-string' before breaking the line
-unless inside a list. Signal an error if within a single-quoted
-string."
+unless inside a list. If within a double-quoted string, insert
+`octave-string-continuation-marker' instead. Signal an error if
+within a single-quoted string."
(interactive)
(funcall comment-line-break-function soft))
(defun octave--indent-new-comment-line (orig &rest args)
- (cond
- ((octave-in-comment-p) nil)
- ((eq (octave-in-string-p) ?')
- (error "Cannot split a single-quoted string"))
- ((eq (octave-in-string-p) ?\")
- (insert octave-continuation-string))
- (t
- (delete-horizontal-space)
- (unless (and (cadr (syntax-ppss))
- (eq (char-after (cadr (syntax-ppss))) ?\())
- (insert " " octave-continuation-string))))
+ (pcase (syntax-ppss)
+ ((app ppss-string-terminator ?\')
+ (user-error "Cannot split a single-quoted string"))
+ ((app ppss-string-terminator ?\")
+ (insert octave-string-continuation-marker))
+ ((pred (not ppss-comment-depth))
+ (delete-horizontal-space)
+ (unless (octave-smie--in-parens-p)
+ (insert " " octave-continuation-string))))
(apply orig args)
(indent-according-to-mode))
@@ -1663,9 +1668,7 @@ code line."
(define-button-type 'octave-help-function
'follow-link t
- 'action (lambda (b)
- (octave-help
- (buffer-substring (button-start b) (button-end b)))))
+ 'action (lambda (b) (octave-help (button-label b))))
(defvar octave-help-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 59f90d7..e6e6e40 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -199,38 +199,32 @@
(defcustom pascal-indent-level 3
"Indentation of Pascal statements with respect to containing block."
- :type 'integer
- :group 'pascal)
+ :type 'integer)
(defcustom pascal-case-indent 2
"Indentation for case statements."
- :type 'integer
- :group 'pascal)
+ :type 'integer)
(defcustom pascal-auto-newline nil
"Non-nil means automatically insert newlines in certain cases.
These include after semicolons and after the punctuation mark after an `end'."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-indent-nested-functions t
"Non-nil means nested functions are indented."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-tab-always-indent t
"Non-nil means TAB in Pascal mode should always reindent the current line.
If this is nil, TAB inserts a tab if it is at the end of the line
and follows non-whitespace text."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-auto-endcomments t
"Non-nil means automatically insert comments after certain `end's.
Specifically, this is done after the ends of case statements and functions.
The name of the function or case is included between the braces."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-auto-lineup '(all)
"List of contexts where auto lineup of :'s or ='s should be done.
@@ -243,8 +237,7 @@ will do all lineups."
(const :tag "Everything" all)
(const :tag "Parameter lists" paramlist)
(const :tag "Declarations" declaration)
- (const :tag "Case statements" case))
- :group 'pascal)
+ (const :tag "Case statements" case)))
(defvar pascal-toggle-completions nil
"If non-nil, `pascal-complete-word' tries all possible completions.
@@ -260,8 +253,7 @@ completions.")
These include integer, real, char, etc.
The types defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
(defcustom pascal-start-keywords
'("begin" "end" "function" "procedure" "repeat" "until" "while"
@@ -270,8 +262,7 @@ are handled in another way, and should not be added to this
list."
These are keywords such as begin, repeat, until, readln.
The procedures and variables defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
(defcustom pascal-separator-keywords
'("downto" "else" "mod" "div" "then")
@@ -279,8 +270,7 @@ are handled in another way, and should not be added to this
list."
These are keywords such as downto, else, mod, then.
Variables and function names defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
;;;
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 0120e4a..c7fa5ab 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -98,8 +98,7 @@
(defface perl-non-scalar-variable
'((t :inherit font-lock-variable-name-face :underline t))
"Face used for non-scalar variables."
- :version "28.1"
- :group 'perl)
+ :version "28.1")
(defvar perl-mode-abbrev-table nil
"Abbrev table in use in perl-mode buffers.")
@@ -640,7 +639,6 @@ This is a non empty list of strings, the checker tool
possibly
followed by required arguments. Once launched it will receive
the Perl source to be checked as its standard input."
:version "26.1"
- :group 'perl
:type '(repeat string))
(defvar-local perl--flymake-proc nil)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index d88d350..19de754 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -41,8 +41,7 @@
:type 'hook
:options '(flyspell-prog-mode abbrev-mode flymake-mode
display-line-numbers-mode
- prettify-symbols-mode)
- :group 'prog-mode)
+ prettify-symbols-mode))
(defvar prog-mode-map
(let ((map (make-sparse-keymap)))
@@ -166,8 +165,7 @@ on the symbol."
:version "25.1"
:type '(choice (const :tag "Never unprettify" nil)
(const :tag "Unprettify when point is inside" t)
- (const :tag "Unprettify when point is inside or at right
edge" right-edge))
- :group 'prog-mode)
+ (const :tag "Unprettify when point is inside or at right
edge" right-edge)))
(defun prettify-symbols--post-command-hook ()
(cl-labels ((get-prop-as-list
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index f610efb..a899de7 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -215,8 +215,7 @@ Blank lines separate paragraphs. Semicolons start comments.
(defcustom scheme-mit-dialect t
"If non-nil, scheme mode is specialized for MIT Scheme.
Set this to nil if you normally use another dialect."
- :type 'boolean
- :group 'scheme)
+ :type 'boolean)
(defcustom dsssl-sgml-declaration
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
@@ -226,26 +225,22 @@ If it is defined as a string this will be inserted into
an empty buffer
which is in `dsssl-mode'. It is typically James Clark's style-sheet
doctype, as required for Jade."
:type '(choice (string :tag "Specified string")
- (const :tag "None" :value nil))
- :group 'scheme)
+ (const :tag "None" :value nil)))
(defcustom scheme-mode-hook nil
"Normal hook run when entering `scheme-mode'.
See `run-hooks'."
- :type 'hook
- :group 'scheme)
+ :type 'hook)
(defcustom dsssl-mode-hook nil
"Normal hook run when entering `dsssl-mode'.
See `run-hooks'."
- :type 'hook
- :group 'scheme)
+ :type 'hook)
;; This is shared by cmuscheme and xscheme.
(defcustom scheme-program-name "scheme"
"Program invoked by the `run-scheme' command."
- :type 'string
- :group 'scheme)
+ :type 'string)
(defvar dsssl-imenu-generic-expression
;; Perhaps this should also look for the style-sheet DTD tags. I'm
@@ -429,12 +424,10 @@ that variable's value is a string."
'(1 font-lock-keyword-face)
'(4 font-lock-function-name-face))
(cons
- (concat "(\\("
- ;; (make-regexp '("case" "cond" "else" "if" "lambda"
- ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
- "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
- "l\\(ambda\\|et\\(\\|\\*\\|rec\\)\\)\\|map\\|or\\|with-mode"
- "\\)\\>")
+ (concat "(" (regexp-opt
+ '("case" "cond" "else" "if" "lambda"
+ "let" "let*" "letrec" "and" "or" "map" "with-mode")
+ 'words))
1)
;; DSSSL syntax
'("(\\(element\\|mode\\|declare-\\w+\\)\\>[ \t]*\\(\\sw+\\)"
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index a863e7e..fab600f 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -51,16 +51,14 @@ the run of whitespace at the beginning of the line.")
"Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line."
- :type 'boolean
- :group 'simula)
+ :type 'boolean)
(defconst simula-indent-level-default 3
"Indentation of SIMULA statements with respect to containing block.")
(defcustom simula-indent-level simula-indent-level-default
"Indentation of SIMULA statements with respect to containing block."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-substatement-offset-default 3
@@ -68,8 +66,7 @@ the run of whitespace at the beginning of the line."
(defcustom simula-substatement-offset simula-substatement-offset-default
"Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-continued-statement-offset-default 3
"Extra indentation for lines not starting a statement or substatement.
@@ -83,16 +80,14 @@ the previous line of the statement.")
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-label-offset-default -4711
"Offset of SIMULA label lines relative to usual indentation.")
(defcustom simula-label-offset simula-label-offset-default
"Offset of SIMULA label lines relative to usual indentation."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-if-indent-default '(0 . 0)
"Extra indentation of THEN and ELSE with respect to the starting IF.
@@ -103,8 +98,7 @@ extra ELSE indentation. IF after ELSE is indented as the
starting IF.")
"Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF."
- :type '(cons integer integer)
- :group 'simula)
+ :type '(cons integer integer))
(defconst simula-inspect-indent-default '(0 . 0)
"Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
@@ -115,16 +109,14 @@ and the cdr extra OTHERWISE indentation.")
"Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation."
- :type '(cons integer integer)
- :group 'simula)
+ :type '(cons integer integer))
(defconst simula-electric-indent-default nil
"Non-nil means `simula-indent-line' function may reindent previous line.")
(defcustom simula-electric-indent simula-electric-indent-default
"Non-nil means `simula-indent-line' function may reindent previous line."
- :type 'boolean
- :group 'simula)
+ :type 'boolean)
(defconst simula-abbrev-keyword-default 'upcase
"Specify how to convert case for SIMULA keywords.
@@ -135,8 +127,7 @@ Value is one of the symbols `upcase', `downcase',
`capitalize',
"Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed."
- :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
- :group 'simula)
+ :type '(choice (const upcase) (const downcase) (const capitalize)(const
nil)))
(defconst simula-abbrev-stdproc-default 'abbrev-table
"Specify how to convert case for standard SIMULA procedure and class names.
@@ -148,16 +139,14 @@ Value is one of the symbols `upcase', `downcase',
`capitalize',
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)
- (const abbrev-table) (const nil))
- :group 'simula)
+ (const abbrev-table) (const nil)))
(defcustom simula-abbrev-file nil
"File with extra abbrev definitions for use in SIMULA mode.
These are used together with the standard abbrev definitions for SIMULA.
Please note that the standard definitions are required
for SIMULA mode to function correctly."
- :type '(choice file (const nil))
- :group 'simula)
+ :type '(choice file (const nil)))
(defvar simula-mode-syntax-table nil
"Syntax table in SIMULA mode buffers.")
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index e85e3cf..613863d 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -104,20 +104,17 @@ reading-string reading prompt string")
(defcustom scheme-band-name nil
"Band loaded by the `run-scheme' command."
- :type '(choice (const nil) string)
- :group 'xscheme)
+ :type '(choice (const nil) string))
(defcustom scheme-program-arguments nil
"Arguments passed to the Scheme program by the `run-scheme' command."
- :type '(choice (const nil) string)
- :group 'xscheme)
+ :type '(choice (const nil) string))
(defcustom xscheme-allow-pipelined-evaluation t
"If non-nil, an expression may be transmitted while another is evaluating.
Otherwise, attempting to evaluate an expression before the previous expression
has finished evaluating will signal an error."
- :type 'boolean
- :group 'xscheme)
+ :type 'boolean)
(defcustom xscheme-startup-message
"This is the Scheme process buffer.
@@ -128,19 +125,16 @@ Type \\[describe-mode] for more information.
"
"String to insert into Scheme process buffer first time it is started.
Is processed with `substitute-command-keys' first."
- :type 'string
- :group 'xscheme)
+ :type 'string)
(defcustom xscheme-signal-death-message nil
"If non-nil, causes a message to be generated when the Scheme process dies."
- :type 'boolean
- :group 'xscheme)
+ :type 'boolean)
(defcustom xscheme-start-hook nil
"If non-nil, a procedure to call when the Scheme process is started.
When called, the current buffer will be the Scheme process-buffer."
:type 'hook
- :group 'xscheme
:version "20.3")
(defun xscheme-evaluation-commands (keymap)
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index fdff0f1..22a29b8 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -1,4 +1,4 @@
-;;; ps-samp.el --- ps-print sample setup code
+;;; ps-samp.el --- ps-print sample setup code -*- lexical-binding: t -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 795577c..84a613d 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -329,6 +329,77 @@ recently executed command not bound to an input event\"."
;;;;; ************************* EMACS CONTROL ************************* ;;;;;
+
+;; And now for something completely different.
+
+;;; repeat-mode
+
+(defcustom repeat-exit-key nil
+ "Key that stops the modal repeating of keys in sequence.
+For example, you can set it to <return> like `isearch-exit'."
+ :type '(choice (const :tag "No special key to exit repeating sequence" nil)
+ (key-sequence :tag "Key that exits repeating sequence"))
+ :group 'convenience
+ :version "28.1")
+
+;;;###autoload
+(define-minor-mode repeat-mode
+ "Toggle Repeat mode.
+When Repeat mode is enabled, and the command symbol has the property named
+`repeat-map', this map is activated temporarily for the next command."
+ :global t :group 'convenience
+ (if (not repeat-mode)
+ (remove-hook 'post-command-hook 'repeat-post-hook)
+ (add-hook 'post-command-hook 'repeat-post-hook)
+ (let* ((keymaps nil)
+ (commands (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push (get s 'repeat-map) keymaps))))))
+ (message "Repeat mode is enabled for %d commands and %d keymaps"
+ (length commands)
+ (length (delete-dups keymaps))))))
+
+(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)
+
+ ;; 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)))
+ ;; 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))
+
+ ;; Adding an exit key
+ (when repeat-exit-key
+ (define-key map repeat-exit-key 'ignore))
+
+ (set-transient-map map)))))))
+
(provide 'repeat)
;;; repeat.el ends here
diff --git a/lisp/shell.el b/lisp/shell.el
index 3212824..53f5d0b 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -463,7 +463,7 @@ Shell buffers. It implements `shell-completion-execonly'
for
(if (pcomplete-match "/")
(pcomplete-here (pcomplete-entries nil
(if shell-completion-execonly
- 'file-executable-p)))
+ #'file-executable-p)))
(pcomplete-here
(nth 2 (shell--command-completion-data)))))
@@ -556,8 +556,7 @@ Variables `comint-output-filter-functions', a hook, and
`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
control whether input and output cause the window to scroll to the end of the
buffer."
- (when (called-interactively-p 'any)
- (error "Can't be called interactively; did you mean `shell-script-mode'
instead?"))
+ :interactive nil
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
diff --git a/lisp/simple.el b/lisp/simple.el
index 0c5bcb6..e54cbed 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -138,6 +138,10 @@ messages are highlighted; this helps to see what messages
were visited."
nil
"Overlay highlighting the current error message in the `next-error' buffer.")
+(defvar global-minor-modes nil
+ "A list of the currently enabled global minor modes.
+This is a list of symbols.")
+
(defcustom next-error-hook nil
"List of hook functions run by `next-error' after visiting source file."
:type 'hook
@@ -1900,55 +1904,126 @@ to get different commands to edit and resubmit."
(defvar extended-command-history nil)
(defvar execute-extended-command--last-typed nil)
+(defcustom read-extended-command-predicate nil
+ "Predicate to use to determine which commands to include when completing.
+If it's nil, include all the commands.
+If it's a functoion, it will be called with two parameters: the
+symbol of the command and a buffer. The predicate should return
+non-nil if the command should be present when doing `M-x TAB'
+in that buffer."
+ :version "28.1"
+ :group 'completion
+ :type `(choice (const :tag "Don't exclude any commands" nil)
+ (const :tag "Exclude commands irrelevant to current buffer's
mode"
+ command-completion-default-include-p)
+ (function :tag "Other function")))
+
(defun read-extended-command ()
- "Read command name to invoke in `execute-extended-command'."
- (minibuffer-with-setup-hook
- (lambda ()
- (add-hook 'post-self-insert-hook
- (lambda ()
- (setq execute-extended-command--last-typed
- (minibuffer-contents)))
- nil 'local)
- (setq-local minibuffer-default-add-function
- (lambda ()
- ;; Get a command name at point in the original buffer
- ;; to propose it after M-n.
- (let ((def (with-current-buffer
- (window-buffer (minibuffer-selected-window))
- (and (commandp (function-called-at-point))
- (format "%S" (function-called-at-point)))))
- (all (sort (minibuffer-default-add-completions)
- #'string<)))
- (if def
- (cons def (delete def all))
- all)))))
- ;; Read a string, completing from and restricting to the set of
- ;; all defined commands. Don't provide any initial input.
- ;; Save the command read on the extended-command history list.
- (completing-read
- (concat (cond
- ((eq current-prefix-arg '-) "- ")
- ((and (consp current-prefix-arg)
- (eq (car current-prefix-arg) 4)) "C-u ")
- ((and (consp current-prefix-arg)
- (integerp (car current-prefix-arg)))
- (format "%d " (car current-prefix-arg)))
- ((integerp current-prefix-arg)
- (format "%d " current-prefix-arg)))
- ;; This isn't strictly correct if `execute-extended-command'
- ;; is bound to anything else (e.g. [menu]).
- ;; It could use (key-description (this-single-command-keys)),
- ;; but actually a prompt other than "M-x" would be confusing,
- ;; because "M-x" is a well-known prompt to read a command
- ;; and it serves as a shorthand for "Extended command: ".
- "M-x ")
- (lambda (string pred action)
- (if (and suggest-key-bindings (eq action 'metadata))
- '(metadata
- (affixation-function . read-extended-command--affixation)
- (category . command))
- (complete-with-action action obarray string pred)))
- #'commandp t nil 'extended-command-history)))
+ "Read command name to invoke in `execute-extended-command'.
+This function uses the `read-extended-command-predicate' user option."
+ (let ((buffer (current-buffer)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'post-self-insert-hook
+ (lambda ()
+ (setq execute-extended-command--last-typed
+ (minibuffer-contents)))
+ nil 'local)
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (let ((def
+ (with-current-buffer
+ (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format
+ "%S" (function-called-at-point)))))
+ (all (sort (minibuffer-default-add-completions)
+ #'string<)))
+ (if def
+ (cons def (delete def all))
+ all)))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4)) "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ "M-x ")
+ (lambda (string pred action)
+ (if (and suggest-key-bindings (eq action 'metadata))
+ '(metadata
+ (affixation-function . read-extended-command--affixation)
+ (category . command))
+ (complete-with-action action obarray string pred)))
+ (lambda (sym)
+ (and (commandp sym)
+ (or (null read-extended-command-predicate)
+ (and (functionp read-extended-command-predicate)
+ (funcall read-extended-command-predicate sym buffer)))))
+ t nil 'extended-command-history))))
+
+(defun command-completion-default-include-p (symbol buffer)
+ "Say whether SYMBOL should be offered as a completion.
+If there's a `completion-predicate' for SYMBOL, the result from
+calling that predicate is called. If there isn't one, this
+predicate is true if the command SYMBOL is applicable to the
+major mode in BUFFER, or any of the active minor modes in
+BUFFER."
+ (if (get symbol 'completion-predicate)
+ ;; An explicit completion predicate takes precedence.
+ (funcall (get symbol 'completion-predicate) symbol buffer)
+ ;; Check the modes.
+ (let ((modes (command-modes symbol)))
+ (or (null modes)
+ ;; Common case: Just a single mode.
+ (if (null (cdr modes))
+ (or (provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer) (car modes))
+ (memq (car modes)
+ (buffer-local-value 'local-minor-modes buffer))
+ (memq (car modes) global-minor-modes))
+ ;; Uncommon case: Multiple modes.
+ (apply #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ modes)
+ (seq-intersection modes
+ (buffer-local-value 'local-minor-modes buffer)
+ #'eq)
+ (seq-intersection modes global-minor-modes #'eq))))))
+
+(defun command-completion-with-modes-p (modes buffer)
+ "Say whether MODES are in action in BUFFER.
+This is the case if either the major mode is derived from one of MODES,
+or (if one of MODES is a minor mode), if it is switched on in BUFFER."
+ (or (apply #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ modes)
+ ;; It's a minor mode.
+ (seq-intersection modes
+ (buffer-local-value 'local-minor-modes buffer)
+ #'eq)
+ (seq-intersection modes global-minor-modes #'eq)))
+
+(defun command-completion-button-p (category buffer)
+ "Return non-nil if there's a button of CATEGORY at point in BUFFER."
+ (with-current-buffer buffer
+ (and (get-text-property (point) 'button)
+ (eq (get-text-property (point) 'category) category))))
(defun read-extended-command--affixation (command-names)
(with-selected-window (or (minibuffer-selected-window) (selected-window))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 48491e4..8a50fbe 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -104,10 +104,10 @@ are integer buffer positions in the reverse order of the
insertion order.")
(defvar skeleton-point)
(defvar skeleton-regions)
-(def-edebug-spec skeleton-edebug-spec
- ([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]]
- &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
- ("quote" def-form) skeleton-edebug-spec def-form))
+(def-edebug-elem-spec 'skeleton-edebug-spec
+ '([&or null stringp (stringp &rest stringp) [[¬ atom] sexp]]
+ &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
+ ("quote" def-form) skeleton-edebug-spec def-form))
;;;###autoload
(defmacro define-skeleton (command documentation &rest skeleton)
"Define a user-configurable COMMAND that enters a statement skeleton.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index e43978f..d64c721 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,4 +1,4 @@
-;;; speedbar --- quick access to files and tags in a frame
+;;; speedbar --- quick access to files and tags in a frame -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -1640,7 +1640,7 @@ variable `speedbar-obj-alist'."
(defmacro speedbar-with-writable (&rest forms)
"Allow the buffer to be writable and evaluate FORMS."
- (declare (indent 0))
+ (declare (indent 0) (debug t))
`(let ((inhibit-read-only t))
,@forms))
@@ -4001,11 +4001,6 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
"Speedbar face for separator labels in a display."
:group 'speedbar-faces)
-;; some edebug hooks
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec speedbar-with-writable def-body)))
-
;; Fix a font lock problem for some versions of Emacs
(and (boundp 'font-lock-global-modes)
font-lock-global-modes
diff --git a/lisp/subr.el b/lisp/subr.el
index 8559be6..a6e39e7 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -64,8 +64,8 @@ For more information, see Info node `(elisp)Declaring
Functions'."
;;;; Basic Lisp macros.
-(defalias 'not 'null)
-(defalias 'sxhash 'sxhash-equal)
+(defalias 'not #'null)
+(defalias 'sxhash #'sxhash-equal)
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
@@ -82,14 +82,27 @@ Testcover will raise an error."
form)
(defmacro def-edebug-spec (symbol spec)
- "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
+ "Set the Edebug SPEC to use for sexps which have SYMBOL as head.
Both SYMBOL and SPEC are unevaluated. The SPEC can be:
0 (instrument no arguments); t (instrument all arguments);
a symbol (naming a function with an Edebug specification); or a list.
The elements of the list describe the argument types; see
Info node `(elisp)Specification List' for details."
+ (declare (indent 1))
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
+(defun def-edebug-elem-spec (name spec)
+ "Define a new Edebug spec element NAME as shorthand for SPEC.
+The SPEC has to be a list."
+ (declare (indent 1))
+ (when (string-match "\\`[&:]" (symbol-name name))
+ ;; & and : have special meaning in spec element names.
+ (error "Edebug spec name cannot start with '&' or ':'"))
+ (unless (consp spec)
+ (error "Edebug spec has to be a list: %S" spec))
+ (put name 'edebug-elem-spec spec))
+
+
(defmacro lambda (&rest cdr)
"Return an anonymous function.
Under dynamic binding, a call of the form (lambda ARGS DOCSTRING
@@ -777,7 +790,7 @@ If TEST is omitted or nil, `equal' is used."
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
- (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key)
(setq found t value (if (consp elt) (cdr elt) default))))
(setq tail (cdr tail)))
value))
@@ -927,14 +940,14 @@ For an approximate inverse of this, see
`key-description'."
"Make MAP override all normally self-inserting keys to be undefined.
Normally, as an exception, digits and minus-sign are set to make prefix args,
but optional second arg NODIGITS non-nil treats them like other chars."
- (define-key map [remap self-insert-command] 'undefined)
+ (define-key map [remap self-insert-command] #'undefined)
(or nodigits
(let (loop)
- (define-key map "-" 'negative-argument)
+ (define-key map "-" #'negative-argument)
;; Make plain numbers do numeric args.
(setq loop ?0)
(while (<= loop ?9)
- (define-key map (char-to-string loop) 'digit-argument)
+ (define-key map (char-to-string loop) #'digit-argument)
(setq loop (1+ loop))))))
(defun make-composed-keymap (maps &optional parent)
@@ -971,8 +984,8 @@ a menu, so this function is not useful for non-menu
keymaps."
(setq key
(if (<= (length key) 1) (aref key 0)
(setq keymap (lookup-key keymap
- (apply 'vector
- (butlast (mapcar 'identity key)))))
+ (apply #'vector
+ (butlast (mapcar #'identity key)))))
(aref key (1- (length key)))))
(let ((tail keymap) done inserted)
(while (and (not done) tail)
@@ -1100,7 +1113,7 @@ Subkeymaps may be modified but are not canonicalized."
(push (cons key item) bindings)))
map)))
;; Create the new map.
- (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
+ (setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt))
(dolist (binding ranges)
;; Treat char-ranges specially. FIXME: need to merge as well.
(define-key map (vector (car binding)) (cdr binding)))
@@ -1739,29 +1752,29 @@ be a list of the form returned by `event-start' and
`event-end'."
;;;; Alternate names for functions - these are not being phased out.
-(defalias 'send-string 'process-send-string)
-(defalias 'send-region 'process-send-region)
-(defalias 'string= 'string-equal)
-(defalias 'string< 'string-lessp)
-(defalias 'string> 'string-greaterp)
-(defalias 'move-marker 'set-marker)
-(defalias 'rplaca 'setcar)
-(defalias 'rplacd 'setcdr)
-(defalias 'beep 'ding) ;preserve lingual purity
-(defalias 'indent-to-column 'indent-to)
-(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'send-string #'process-send-string)
+(defalias 'send-region #'process-send-region)
+(defalias 'string= #'string-equal)
+(defalias 'string< #'string-lessp)
+(defalias 'string> #'string-greaterp)
+(defalias 'move-marker #'set-marker)
+(defalias 'rplaca #'setcar)
+(defalias 'rplacd #'setcdr)
+(defalias 'beep #'ding) ;preserve lingual purity
+(defalias 'indent-to-column #'indent-to)
+(defalias 'backward-delete-char #'delete-backward-char)
(defalias 'search-forward-regexp (symbol-function 're-search-forward))
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
-(defalias 'int-to-string 'number-to-string)
-(defalias 'store-match-data 'set-match-data)
-(defalias 'chmod 'set-file-modes)
-(defalias 'mkdir 'make-directory)
+(defalias 'int-to-string #'number-to-string)
+(defalias 'store-match-data #'set-match-data)
+(defalias 'chmod #'set-file-modes)
+(defalias 'mkdir #'make-directory)
;; These are the XEmacs names:
-(defalias 'point-at-eol 'line-end-position)
-(defalias 'point-at-bol 'line-beginning-position)
+(defalias 'point-at-eol #'line-end-position)
+(defalias 'point-at-bol #'line-beginning-position)
(define-obsolete-function-alias 'user-original-login-name
- 'user-login-name "28.1")
+ #'user-login-name "28.1")
;;;; Hook manipulation functions.
@@ -1875,7 +1888,7 @@ one will be removed."
(if local "Buffer-local" "Global"))
fn-alist
nil t)
- fn-alist nil nil 'string=)))
+ fn-alist nil nil #'string=)))
(list hook function local)))
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
@@ -2087,9 +2100,9 @@ can do the job."
(if (cond
((null compare-fn)
(member element (symbol-value list-var)))
- ((eq compare-fn 'eq)
+ ((eq compare-fn #'eq)
(memq element (symbol-value list-var)))
- ((eq compare-fn 'eql)
+ ((eq compare-fn #'eql)
(memql element (symbol-value list-var)))
(t
(let ((lst (symbol-value list-var)))
@@ -2307,7 +2320,8 @@ tho trying to avoid AVOIDED-MODES."
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
"Register a new minor mode.
-This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
+This function shouldn't be used directly -- use `define-minor-mode'
+instead (which will then call this function).
TOGGLE is a symbol that is the name of a buffer-local variable that
is toggled on or off to say whether the minor mode is active or not.
@@ -2520,7 +2534,7 @@ program before the output is collected. If
STATUS-HANDLER is
NIL, an error is signalled if the program returns with a non-zero
exit status."
(with-temp-buffer
- (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (let ((status (apply #'call-process program nil (current-buffer) nil
args)))
(if status-handler
(funcall status-handler status)
(unless (eq status 0)
@@ -2566,7 +2580,7 @@ process."
(format "Buffer %S has a running process; kill it? "
(buffer-name (current-buffer)))))))
-(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function)
+(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function)
;; process plist management
@@ -2754,7 +2768,7 @@ by doing (clear-string STRING)."
(use-local-map read-passwd-map)
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
- (add-hook 'post-command-hook 'read-password--hide-password nil t))
+ (add-hook 'post-command-hook #'read-password--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
(read-hide-char (or read-hide-char ?*)))
@@ -2764,8 +2778,8 @@ by doing (clear-string STRING)."
;; Not sure why but it seems that there might be cases where the
;; minibuffer is not always properly reset later on, so undo
;; whatever we've done here (bug#11392).
- (remove-hook 'after-change-functions
'read-password--hide-password
- 'local)
+ (remove-hook 'after-change-functions
+ #'read-password--hide-password 'local)
(kill-local-variable 'post-self-insert-hook)
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
@@ -2795,7 +2809,7 @@ This function is used by the `interactive' code letter
`n'."
prompt nil nil nil (or hist 'read-number-history)
(when default
(if (consp default)
- (mapcar 'number-to-string (delq nil default))
+ (mapcar #'number-to-string (delq nil default))
(number-to-string default))))))
(condition-case nil
(setq n (cond
@@ -2949,13 +2963,13 @@ If there is a natural number at point, use it as
default."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map [remap self-insert-command]
'read-char-from-minibuffer-insert-char)
+ (define-key map [remap self-insert-command]
#'read-char-from-minibuffer-insert-char)
- (define-key map [remap recenter-top-bottom]
'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down-command]
'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window]
'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down]
'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter-top-bottom]
#'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down-command]
#'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window]
#'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down]
#'minibuffer-scroll-other-window-down)
map)
"Keymap for the `read-char-from-minibuffer' function.")
@@ -3018,9 +3032,9 @@ There is no need to explicitly add `help-char' to CHARS;
(help-form-show)))))
(dolist (char chars)
(define-key map (vector char)
- 'read-char-from-minibuffer-insert-char))
+ #'read-char-from-minibuffer-insert-char))
(define-key map [remap self-insert-command]
- 'read-char-from-minibuffer-insert-other)
+ #'read-char-from-minibuffer-insert-other)
(puthash (list help-form (cons help-char chars))
map read-char-from-minibuffer-map-hash)
map))
@@ -3053,26 +3067,26 @@ There is no need to explicitly add `help-char' to CHARS;
(set-keymap-parent map minibuffer-local-map)
(dolist (symbol '(act act-and-show act-and-exit automatic))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y))
- (define-key map [remap skip] 'y-or-n-p-insert-n)
+ (define-key map [remap skip] #'y-or-n-p-insert-n)
(dolist (symbol '(backup undo undo-all edit edit-replacement
delete-and-edit ignore self-insert-command))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other))
- (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down] 'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window]
'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down]
'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter] #'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down] #'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window]
#'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down]
#'minibuffer-scroll-other-window-down)
- (define-key map [escape] 'abort-recursive-edit)
+ (define-key map [escape] #'abort-recursive-edit)
(dolist (symbol '(quit exit exit-prefix))
- (define-key map (vector 'remap symbol) 'abort-recursive-edit))
+ (define-key map (vector 'remap symbol) #'abort-recursive-edit))
;; FIXME: try catch-all instead of explicit bindings:
- ;; (define-key map [remap t] 'y-or-n-p-insert-other)
+ ;; (define-key map [remap t] #'y-or-n-p-insert-other)
map)
"Keymap that defines additional bindings for `y-or-n-p' answers.")
@@ -3369,7 +3383,7 @@ This finishes the change group by reverting all of its
changes."
;; For compatibility.
(define-obsolete-function-alias 'redraw-modeline
- 'force-mode-line-update "24.3")
+ #'force-mode-line-update "24.3")
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
@@ -3513,7 +3527,7 @@ When in a major mode that does not provide its own
symbol at point exactly."
(let ((tag (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default))))
+ #'find-tag-default))))
(if tag (regexp-quote tag))))
(defun find-tag-default-as-symbol-regexp ()
@@ -3527,8 +3541,8 @@ symbol at point exactly."
(if (and tag-regexp
(eq (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default)
- 'find-tag-default))
+ #'find-tag-default)
+ #'find-tag-default))
(format "\\_<%s\\_>" tag-regexp)
tag-regexp)))
@@ -3862,7 +3876,7 @@ discouraged."
(call-process shell-file-name
infile buffer display
shell-command-switch
- (mapconcat 'identity (cons command args) " ")))
+ (mapconcat #'identity (cons command args) " ")))
(defun process-file-shell-command (command &optional infile buffer display
&rest args)
@@ -3874,7 +3888,7 @@ Similar to `call-process-shell-command', but calls
`process-file'."
(with-connection-local-variables
(process-file
shell-file-name infile buffer display shell-command-switch
- (mapconcat 'identity (cons command args) " "))))
+ (mapconcat #'identity (cons command args) " "))))
(defun call-shell-region (start end command &optional delete buffer)
"Send text from START to END as input to an inferior shell running COMMAND.
@@ -4335,6 +4349,8 @@ the specified region. It must not change
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single (apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'."
+ (if (markerp beg) (setq beg (marker-position beg)))
+ (if (markerp end) (setq end (marker-position end)))
(let ((old-bul buffer-undo-list)
(end-marker (copy-marker end t))
result)
@@ -4891,8 +4907,8 @@ FILE, a string, is described in the function
`eval-after-load'."
""
;; Note: regexp-opt can't be used here, since we need to call
;; this before Emacs has been fully started. 2006-05-21
- (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
- "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
+ (concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|")
"\\)?"))
+ "\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|")
"\\)?\\'"))
(defun load-history-filename-element (file-regexp)
@@ -4908,7 +4924,6 @@ Return nil if there isn't one."
load-elt (and loads (car loads)))))
load-elt))
-(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
"Arrange that if FILE is loaded, FORM will be run immediately afterwards.
If FILE is already loaded, evaluate FORM right now.
@@ -4943,7 +4958,8 @@ like `font-lock'.
This function makes or adds to an entry on `after-load-alist'.
See also `with-eval-after-load'."
- (declare (compiler-macro
+ (declare (indent 1)
+ (compiler-macro
(lambda (whole)
(if (eq 'quote (car-safe form))
;; Quote with lambda so the compiler can look inside.
@@ -5050,7 +5066,7 @@ This function is called directly from the C code."
"Display delayed warnings from `delayed-warnings-list'.
Used from `delayed-warnings-hook' (which see)."
(dolist (warning (nreverse delayed-warnings-list))
- (apply 'display-warning warning))
+ (apply #'display-warning warning))
(setq delayed-warnings-list nil))
(defun collapse-delayed-warnings ()
@@ -5383,7 +5399,7 @@ The properties used on SYMBOL are `composefunc',
`sendfunc',
`abortfunc', and `hookvar'."
(put symbol 'composefunc composefunc)
(put symbol 'sendfunc sendfunc)
- (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'abortfunc (or abortfunc #'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
@@ -5548,7 +5564,7 @@ To test whether a function can be called interactively,
use
(set symbol tail)))))
(define-obsolete-function-alias
- 'set-temporary-overlay-map 'set-transient-map "24.4")
+ 'set-temporary-overlay-map #'set-transient-map "24.4")
(defun set-transient-map (map &optional keep-pred on-exit)
"Set MAP as a temporary keymap taking precedence over other keymaps.
@@ -6176,7 +6192,7 @@ returned list are in the same order as in TREE.
;; Technically, `flatten-list' is a misnomer, but we provide it here
;; for discoverability:
-(defalias 'flatten-list 'flatten-tree)
+(defalias 'flatten-list #'flatten-tree)
;; The initial anchoring is for better performance in searching matches.
(defconst regexp-unmatchable "\\`a\\`"
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 6720d82..dba79fb 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -89,8 +89,9 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
:set (lambda (sym val)
(set-default sym val)
;; Reenable the tab-bar with new keybindings
- (tab-bar-mode -1)
- (tab-bar-mode 1))
+ (when tab-bar-mode
+ (tab-bar-mode -1)
+ (tab-bar-mode 1)))
:group 'tab-bar
:version "27.1")
@@ -134,21 +135,48 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
:ascent center))
tab-bar-close-button)))
+(defun tab-bar--tab-bar-lines-for-frame (frame)
+ "Determine and return the value of `tab-bar-lines' for FRAME.
+Return 0 if `tab-bar-mode' is not enabled. Otherwise return
+either 1 or 0 depending on the value of the customizable variable
+`tab-bar-show', which see."
+ (cond
+ ((not tab-bar-mode) 0)
+ ((not tab-bar-show) 0)
+ ((eq tab-bar-show t) 1)
+ ((natnump tab-bar-show)
+ (if (> (length (funcall tab-bar-tabs-function frame)) tab-bar-show) 1 0))))
+
+(defun tab-bar--update-tab-bar-lines (&optional frames)
+ "Update the `tab-bar-lines' parameter in frames.
+Update the tab-bar-lines frame parameter. If the optional
+parameter FRAMES is omitted, update only the currently selected
+frame. If it is `t', update all frames as well as the default
+for new frames. Otherwise FRAMES should be a list of frames to
+update."
+ (let ((frame-lst (cond ((null frames)
+ (list (selected-frame)))
+ ((eq frames t)
+ (frame-list))
+ (t frames))))
+ ;; Loop over all frames and update default-frame-alist
+ (dolist (frame frame-lst)
+ (unless (frame-parameter frame 'tab-bar-lines-keep-state)
+ (set-frame-parameter frame 'tab-bar-lines
(tab-bar--tab-bar-lines-for-frame frame)))))
+ (when (eq frames t)
+ (setq default-frame-alist
+ (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show
t)) 1 0))
+ (assq-delete-all 'tab-bar-lines default-frame-alist)))))
+
(define-minor-mode tab-bar-mode
"Toggle the tab bar in all graphical frames (Tab Bar mode)."
:global t
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable tab-bar-mode
- (let ((val (if tab-bar-mode 1 0)))
- (dolist (frame (frame-list))
- (set-frame-parameter frame 'tab-bar-lines val))
- ;; If the user has given `default-frame-alist' a `tab-bar-lines'
- ;; parameter, replace it.
- (if (assq 'tab-bar-lines default-frame-alist)
- (setq default-frame-alist
- (cons (cons 'tab-bar-lines val)
- (assq-delete-all 'tab-bar-lines
- default-frame-alist)))))
+
+ ;; Recalculate tab-bar-lines for all frames
+ (tab-bar--update-tab-bar-lines t)
+
(when tab-bar-mode
(tab-bar--load-buttons))
(if tab-bar-mode
@@ -206,7 +234,9 @@ new frame when the global `tab-bar-mode' is enabled, by
using
(add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
(interactive)
(set-frame-parameter frame 'tab-bar-lines
- (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
+ (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1))
+ (set-frame-parameter frame 'tab-bar-lines-keep-state
+ (not (frame-parameter frame
'tab-bar-lines-keep-state))))
(defvar tab-bar-map (make-sparse-keymap)
"Keymap for the tab bar.
@@ -250,17 +280,9 @@ you can use the command `toggle-frame-tab-bar'."
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
- ;; Preload button images
- (tab-bar-mode 1)
- ;; Then handle each frame individually
- (dolist (frame (frame-list))
- (set-frame-parameter
- frame 'tab-bar-lines
- (if (or (eq val t)
- (and (natnump val)
- (> (length (funcall tab-bar-tabs-function frame))
- val)))
- 1 0))))
+ (if val
+ (tab-bar-mode 1)
+ (tab-bar--update-tab-bar-lines t)))
:group 'tab-bar
:version "27.1")
@@ -852,16 +874,12 @@ After the tab is created, the hooks in
(run-hook-with-args 'tab-bar-tab-post-open-functions
(nth to-index tabs)))
- (cond
- ((eq tab-bar-show t)
- (tab-bar-mode 1))
- ((and (natnump tab-bar-show)
- (> (length (funcall tab-bar-tabs-function)) tab-bar-show)
- (zerop (frame-parameter nil 'tab-bar-lines)))
- (progn
- (tab-bar--load-buttons)
- (tab-bar--define-keys)
- (set-frame-parameter nil 'tab-bar-lines 1))))
+ (when tab-bar-show
+ (if (not tab-bar-mode)
+ ;; Switch on tab-bar-mode, since a tab was created
+ ;; Note: This also updates tab-bar-lines
+ (tab-bar-mode 1)
+ (tab-bar--update-tab-bar-lines)))
(force-mode-line-update)
(unless tab-bar-mode
@@ -879,6 +897,14 @@ If ARG is zero, create a new tab in place of the current
tab."
(tab-bar-new-tab-to (1+ to-index)))
(tab-bar-new-tab-to)))
+(defun tab-bar-duplicate-tab (&optional arg)
+ "Duplicate the current tab to ARG positions to the right.
+If a negative ARG, duplicate the tab to ARG positions to the left.
+If ARG is zero, duplicate the tab in place of the current tab."
+ (interactive "P")
+ (let ((tab-bar-new-tab-choice nil))
+ (tab-bar-new-tab arg)))
+
(defvar tab-bar-closed-tabs nil
"A list of closed tabs to be able to undo their closing.")
@@ -996,11 +1022,8 @@ for the last tab on a frame is determined by
tab-bar-closed-tabs)
(set-frame-parameter nil 'tabs (delq close-tab tabs)))
- (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
- (natnump tab-bar-show)
- (<= (length (funcall tab-bar-tabs-function))
- tab-bar-show))
- (set-frame-parameter nil 'tab-bar-lines 0))
+ ;; Recalculate tab-bar-lines and update frames
+ (tab-bar--update-tab-bar-lines)
(force-mode-line-update)
(unless tab-bar-mode
@@ -1036,11 +1059,8 @@ for the last tab on a frame is determined by
(run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index
tabs) nil)))
(set-frame-parameter nil 'tabs (list (nth current-index tabs)))
- (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
- (natnump tab-bar-show)
- (<= (length (funcall tab-bar-tabs-function))
- tab-bar-show))
- (set-frame-parameter nil 'tab-bar-lines 0))
+ ;; Recalculate tab-bar-lines and update frames
+ (tab-bar--update-tab-bar-lines)
(force-mode-line-update)
(unless tab-bar-mode
@@ -1231,6 +1251,7 @@ and can restore them."
(defalias 'tab-new 'tab-bar-new-tab)
(defalias 'tab-new-to 'tab-bar-new-tab-to)
+(defalias 'tab-duplicate 'tab-bar-duplicate-tab)
(defalias 'tab-close 'tab-bar-close-tab)
(defalias 'tab-close-other 'tab-bar-close-other-tabs)
(defalias 'tab-undo 'tab-bar-undo-close-tab)
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index fe92d60..c44b69c 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -50,8 +50,7 @@
(defcustom enriched-verbose t
"If non-nil, give status messages when reading and writing files."
- :type 'boolean
- :group 'enriched)
+ :type 'boolean)
;;;
;;; Set up faces & display table
@@ -65,14 +64,12 @@
"Face used for text that must be shown in fixed width.
Currently, Emacs can only display fixed-width fonts, but this may change.
This face is used for text specifically marked as fixed-width, for example
-in text/enriched files."
- :group 'enriched)
+in text/enriched files.")
(defface excerpt
'((t (:slant italic)))
"Face used for text that is an excerpt from another document.
-This is used in Enriched mode for text explicitly marked as an excerpt."
- :group 'enriched)
+This is used in Enriched mode for text explicitly marked as an excerpt.")
(defconst enriched-display-table (or (copy-sequence standard-display-table)
(make-display-table)))
@@ -146,8 +143,7 @@ Any property that is neither on this list nor dealt with by
If you set variables in this hook, you should arrange for them to be restored
to their old values if you leave Enriched mode. One way to do this is to add
them and their old values to `enriched-old-bindings'."
- :type 'hook
- :group 'enriched)
+ :type 'hook)
(defcustom enriched-allow-eval-in-display-props nil
"If non-nil allow to evaluate arbitrary forms in display properties.
@@ -162,8 +158,7 @@ Note, however, that applying unsafe display properties could
execute malicious Lisp code, if that code came from an external source."
:risky t
:type 'boolean
- :version "26.1"
- :group 'enriched)
+ :version "26.1")
(defvar-local enriched-old-bindings nil
"Store old variable values that we change when entering mode.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index ea46270..cee578f 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -131,8 +131,7 @@
(defcustom ispell-highlight-p 'block
"Highlight spelling errors when non-nil.
When set to `block', assumes a block cursor with TTY displays."
- :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t)))
(defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup)
"Controls the lazy-highlighting of spelling errors.
@@ -141,7 +140,6 @@ error is highlighted lazily using isearch lazy highlighting
(see
`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
:type 'boolean
:group 'lazy-highlight
- :group 'ispell
:version "22.1")
(defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
@@ -149,16 +147,14 @@ error is highlighted lazily using isearch lazy
highlighting (see
This variable can be set by the user to whatever face they desire.
It's most convenient if the cursor color and highlight color are
slightly different."
- :type 'face
- :group 'ispell)
+ :type 'face)
(defcustom ispell-check-comments t
"Spelling of comments checked when non-nil.
When set to `exclusive', ONLY comments are checked. (For code comments).
Warning! Not checking comments, when a comment start is embedded in strings,
may produce undesired results."
- :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t)))
;;;###autoload
(put 'ispell-check-comments 'safe-local-variable
(lambda (a) (memq a '(nil t exclusive))))
@@ -166,8 +162,7 @@ may produce undesired results."
(defcustom ispell-query-replace-choices nil
"Corrections made throughout region when non-nil.
Uses `query-replace' (\\[query-replace]) for corrections."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-skip-tib nil
"Does not spell check `tib' bibliography references when non-nil.
@@ -177,8 +172,7 @@ Skips any text between strings matching regular expressions
TeX users beware: Any text between [. and .] will be skipped -- even if
that's your whole buffer -- unless you set `ispell-skip-tib' to nil.
That includes the [.5mm] type of number..."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvar ispell-tib-ref-beginning "[[<]\\."
"Regexp matching the beginning of a Tib reference.")
@@ -189,14 +183,12 @@ That includes the [.5mm] type of number..."
(defcustom ispell-keep-choices-win t
"If non-nil, keep the `*Choices*' window for the entire spelling session.
This minimizes redisplay thrashing."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-choices-win-default-height 2
"The default size of the `*Choices*' window, including the mode line.
Must be greater than 1."
- :type 'integer
- :group 'ispell)
+ :type 'integer)
(defcustom ispell-program-name
(or (executable-find "aspell")
@@ -211,8 +203,7 @@ Must be greater than 1."
:set (lambda (symbol value)
(set-default symbol value)
(if (featurep 'ispell)
- (ispell-set-spellchecker-params)))
- :group 'ispell)
+ (ispell-set-spellchecker-params))))
(defcustom ispell-alternate-dictionary
(cond ((file-readable-p "/usr/dict/web2") "/usr/dict/web2")
@@ -224,14 +215,12 @@ Must be greater than 1."
"/usr/share/lib/dict/words")
((file-readable-p "/sys/dict") "/sys/dict"))
"Alternate plain word-list dictionary for spelling help."
- :type '(choice file (const :tag "None" nil))
- :group 'ispell)
+ :type '(choice file (const :tag "None" nil)))
(defcustom ispell-complete-word-dict nil
"Plain word-list dictionary used for word completion if
different from `ispell-alternate-dictionary'."
- :type '(choice file (const :tag "None" nil))
- :group 'ispell)
+ :type '(choice file (const :tag "None" nil)))
(defcustom ispell-message-dictionary-alist nil
"List used by `ispell-message' to select a new dictionary.
@@ -241,29 +230,25 @@ DICTIONARY if `ispell-local-dictionary' is not
buffer-local.
E.g. you may use the following value:
((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\")
(\"^To:[^\\n,]+\\\\.de[ \\t\\n,>]\" . \"deutsch8\"))"
- :type '(repeat (cons regexp string))
- :group 'ispell)
+ :type '(repeat (cons regexp string)))
(defcustom ispell-message-fcc-skip 50000
"Query before saving Fcc message copy if attachment larger than this value.
Always stores Fcc copy of message when nil."
- :type '(choice integer (const :tag "off" nil))
- :group 'ispell)
+ :type '(choice integer (const :tag "off" nil)))
(defcustom ispell-grep-command
"grep"
"Name of the grep command for search processes."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-grep-options
"-Ei"
"String of options to use when running the program in `ispell-grep-command'.
Should probably be \"-Ei\"."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-look-command
(cond ((file-exists-p "/bin/look") "/bin/look")
@@ -272,36 +257,30 @@ Should probably be \"-Ei\"."
(t "look"))
"Name of the look command for search processes.
This must be an absolute file name."
- :type 'file
- :group 'ispell)
+ :type 'file)
(defcustom ispell-look-p (file-exists-p ispell-look-command)
"Non-nil means use `look' rather than `grep'.
Default is based on whether `look' seems to be available."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-have-new-look nil
"Non-nil means use the `-r' option (regexp) when running `look'."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-look-options (if ispell-have-new-look "-dfr" "-df")
"String of command options for `ispell-look-command'."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-use-ptys-p nil
"When non-nil, Emacs uses ptys to communicate with Ispell.
When nil, Emacs uses pipes."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-following-word nil
"Non-nil means `ispell-word' checks the word around or after point.
Otherwise `ispell-word' checks the preceding word."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-help-in-bufferp nil
"Non-nil means display interactive keymap help in a buffer.
@@ -312,21 +291,18 @@ The following values are supported:
for a couple of seconds.
electric Pop up a new buffer and display a long help message there.
User can browse and then exit the help mode."
- :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t)))
(defcustom ispell-quietly nil
"Non-nil means suppress messages in `ispell-word'."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvaralias 'ispell-format-word 'ispell-format-word-function)
(defcustom ispell-format-word-function (function upcase)
"Formatting function for displaying word being spell checked.
The function must take one string argument and return a string."
- :type 'function
- :group 'ispell)
+ :type 'function)
;; FIXME framepop.el last updated c 2003 (?),
;; use posframe.
@@ -335,21 +311,18 @@ The function must take one string argument and return a
string."
You can set this variable to dynamically use framepop if you are in a
window system by evaluating the following on startup to set this variable:
(and (display-graphic-p) (require \\='framepop nil t))"
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
;;;###autoload
(defcustom ispell-personal-dictionary nil
"File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary for your spelling checker is used."
:type '(choice file
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
(defcustom ispell-silently-savep nil
"When non-nil, save personal dictionary without asking for confirmation."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvar-local ispell-local-dictionary-overridden nil
"Non-nil means the user has explicitly set this buffer's Ispell dictionary.")
@@ -366,8 +339,7 @@ calling \\[ispell-change-dictionary] with that value. This
variable
is automatically set when defined in the file with either
`ispell-dictionary-keyword' or the Local Variable syntax."
:type '(choice string
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
;;;###autoload
(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
@@ -376,16 +348,14 @@ is automatically set when defined in the file with either
(defcustom ispell-dictionary nil
"Default dictionary to use if `ispell-local-dictionary' is nil."
:type '(choice string
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
(defcustom ispell-extra-args nil
"If non-nil, a list of extra switches to pass to the Ispell program.
For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
words as correct. See also `ispell-dictionary-alist', which may be used
for language-specific arguments."
- :type '(repeat string)
- :group 'ispell)
+ :type '(repeat string))
@@ -400,8 +370,7 @@ such as \"&\". See `ispell-html-skip-alists' for more
details.
This variable affects spell-checking of HTML, XML, and SGML files."
:type '(choice (const :tag "always" t) (const :tag "never" nil)
- (const :tag "use-mode-name" use-mode-name))
- :group 'ispell)
+ (const :tag "use-mode-name" use-mode-name)))
(make-variable-buffer-local 'ispell-skip-html)
@@ -427,8 +396,7 @@ re-start Emacs."
(const "~nroff") (const "~list")
(const "~latin1") (const "~latin3")
(const :tag "default" nil))
- (coding-system :tag "Coding System")))
- :group 'ispell)
+ (coding-system :tag "Coding System"))))
(defvar ispell-dictionary-base-alist
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index e48649b..f63894b 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -59,16 +59,14 @@
(defcustom makeinfo-run-command "makeinfo"
"Command used to run `makeinfo' subjob.
The name of the file is appended to this string, separated by a space."
- :type 'string
- :group 'makeinfo)
+ :type 'string)
(defcustom makeinfo-options "--fill-column=70"
"String containing options for running `makeinfo'.
Do not include `--footnote-style' or `--paragraph-indent';
the proper way to specify those is with the Texinfo commands
`@footnotestyle' and `@paragraphindent'."
- :type 'string
- :group 'makeinfo)
+ :type 'string)
(require 'texinfo)
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 96edfd6..472c406 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -96,7 +96,6 @@ lines that start paragraphs from lines that separate them.
If the variable `use-hard-newlines' is non-nil, then only lines following a
hard newline are considered to match."
- :group 'paragraphs
:type 'regexp)
(put 'paragraph-start 'safe-local-variable 'stringp)
@@ -114,7 +113,6 @@ This is matched against the text at the left margin, which
is not necessarily
the beginning of the line, so it should not use \"^\" as an anchor. This
ensures that the paragraph functions will work equally within a region of
text indented by a margin setting."
- :group 'paragraphs
:type 'regexp)
(put 'paragraph-separate 'safe-local-variable 'stringp)
@@ -149,7 +147,6 @@ regexp describing the end of a sentence, when the value of
the variable
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
- :group 'paragraphs
:type 'string)
(put 'sentence-end-without-space 'safe-local-variable 'stringp)
@@ -161,13 +158,11 @@ All paragraph boundaries also end sentences, regardless.
The value nil means to use the default value defined by the
function `sentence-end'. You should always use this function
to obtain the value of this variable."
- :group 'paragraphs
:type '(choice regexp (const :tag "Use default value" nil)))
(put 'sentence-end 'safe-local-variable 'string-or-null-p)
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
- :group 'paragraphs
:type 'regexp
:version "25.1")
(put 'sentence-end-base 'safe-local-variable 'stringp)
@@ -197,14 +192,12 @@ in between. See Info node `(elisp)Standard Regexps'."
(defcustom page-delimiter "^\014"
"Regexp describing line-beginnings that separate pages."
- :group 'paragraphs
:type 'regexp)
(put 'page-delimiter 'safe-local-variable 'stringp)
(defcustom paragraph-ignore-fill-prefix nil
"Non-nil means the paragraph commands are not affected by `fill-prefix'.
This is desirable in modes where blank lines are the paragraph delimiters."
- :group 'paragraphs
:type 'boolean)
(put 'paragraph-ignore-fill-prefix 'safe-local-variable 'booleanp)
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 3cb1043..1368af0 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -37,28 +37,22 @@
(defcustom picture-rectangle-ctl ?+
"Character `picture-draw-rectangle' uses for top left corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-ctr ?+
"Character `picture-draw-rectangle' uses for top right corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-cbr ?+
"Character `picture-draw-rectangle' uses for bottom right corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-cbl ?+
"Character `picture-draw-rectangle' uses for bottom left corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-v ?|
"Character `picture-draw-rectangle' uses for vertical lines."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-h ?-
"Character `picture-draw-rectangle' uses for horizontal lines."
- :type 'character
- :group 'picture)
+ :type 'character)
;; Picture Movement Commands
@@ -409,8 +403,7 @@ character `\\' in the set it must be preceded by itself:
\"\\\\\".
The command \\[picture-tab-search] is defined to move beneath (or to) a
character belonging to this set independent of the tab stops list."
- :type 'string
- :group 'picture)
+ :type 'string)
(defun picture-set-tab-stops (&optional arg)
"Set value of `tab-stop-list' according to context of this line.
@@ -682,8 +675,7 @@ Leaves the region surrounding the rectangle."
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
Picture mode is invoked by the command \\[picture-mode]."
- :type 'hook
- :group 'picture)
+ :type 'hook)
(defvar picture-mode-old-local-map)
(defvar picture-mode-old-mode-name)
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index bff5712..2f3e024 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -65,8 +65,7 @@
(defcustom r2b-trace-on nil
"Non-nil means trace conversion."
- :type 'boolean
- :group 'refbib)
+ :type 'boolean)
(defcustom r2b-journal-abbrevs
'(
@@ -83,8 +82,7 @@ letter, even if it really doesn't.
\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
\"Artificial Intelligence\", but would replace Ijcai81 with the
BibTeX macro \"ijcai7\"."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defcustom r2b-booktitle-abbrevs
'(
@@ -101,8 +99,7 @@ should be listed as beginning with a capital letter, even if
it doesn't.
\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
\"Artificial Intelligence\", but would replace Ijcai81 with the
BibTeX macro \"ijcai7\"."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defcustom r2b-proceedings-list
'()
@@ -119,8 +116,7 @@ a conference, and its expansion is the BibTeX macro
\"ijcai7\". Then
expansion were \"Proceedings of the Seventh International Conference
on Artificial Intelligence\", then you would NOT need to include Ijcai81
in `r2b-proceedings-list' (although it wouldn't cause an error)."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defvar r2b-additional-stop-words
"Some\\|What"
@@ -129,8 +125,7 @@ This is in addition to the
`r2b-capitalize-title-stop-words'.")
(defcustom r2b-delimit-with-quote t
"If true, then use \" to delimit fields, otherwise use braces."
- :type 'boolean
- :group 'refbib)
+ :type 'boolean)
;**********************************************************
; Utility Functions
@@ -205,13 +200,11 @@ This is in addition to the
`r2b-capitalize-title-stop-words'.")
(defcustom r2b-out-buf-name "*Out*"
"Name of buffer for output from refer-to-bibtex."
- :type 'string
- :group 'refbib)
+ :type 'string)
(defcustom r2b-log-name "*Log*"
"Name of buffer for logs errors from refer-to-bibtex."
- :type 'string
- :group 'refbib)
+ :type 'string)
(defvar r2b-in-buf nil)
(defvar r2b-out-buf nil)
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index ae1f778..c2bf90f 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -91,8 +91,7 @@ the default search path. Since Refer does not know that
default path,
it cannot search it. Include that path explicitly in your BIBINPUTS
environment if you really want it searched (which is not likely to
happen anyway)."
- :type '(choice (repeat directory) (const bibinputs) (const texinputs))
- :group 'refer)
+ :type '(choice (repeat directory) (const bibinputs) (const texinputs)))
(defcustom refer-bib-files 'dir
"List of \\.bib files to search for references,
@@ -110,16 +109,14 @@ If `refer-bib-files' is nil, auto or dir, it is setq'd to
the appropriate
list of files when it is first used if `refer-cache-bib-files' is t. If
`refer-cache-bib-files' is nil, the list of \\.bib files to use is re-read
each time it is needed."
- :type '(choice (repeat file) (const nil) (const auto) (const dir))
- :group 'refer)
+ :type '(choice (repeat file) (const nil) (const auto) (const dir)))
(defcustom refer-cache-bib-files t
"Variable determining whether the value of `refer-bib-files' should be
cached.
If t, initialize the value of refer-bib-files the first time it is used. If
nil, re-read the list of \\.bib files depending on the value of
`refer-bib-files'
each time it is needed."
- :type 'boolean
- :group 'refer)
+ :type 'boolean)
(defcustom refer-bib-files-regexp "\\\\bibliography"
"Regexp matching a bibliography file declaration.
@@ -131,8 +128,7 @@ command is expected to specify a file name, or a list of
comma-separated file
names, within curly braces.
If a specified file doesn't exist and has no extension, a \\.bib extension
is automatically tried."
- :type 'regexp
- :group 'refer)
+ :type 'regexp)
(make-variable-buffer-local 'refer-bib-files)
(make-variable-buffer-local 'refer-cache-bib-files)
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 820ee38..6a72ebb 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -193,24 +193,20 @@
(defcustom remember-mode-hook nil
"Functions run upon entering `remember-mode'."
:type 'hook
- :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template)
- :group 'remember)
+ :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template))
(defcustom remember-in-new-frame nil
"Non-nil means use a separate frame for capturing remember data."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
(defcustom remember-register ?R
"The register in which the window configuration is stored."
- :type 'character
- :group 'remember)
+ :type 'character)
(defcustom remember-filter-functions nil
"Functions run to filter remember data.
All functions are run in the remember buffer."
- :type 'hook
- :group 'remember)
+ :type 'hook)
(defcustom remember-handler-functions '(remember-append-to-file)
"Functions run to process remember data.
@@ -223,13 +219,11 @@ recorded somewhere by that function."
remember-append-to-file
remember-store-in-files
remember-diary-extract-entries
- org-remember-handler)
- :group 'remember)
+ org-remember-handler))
(defcustom remember-all-handler-functions nil
"If non-nil every function in `remember-handler-functions' is called."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;; See below for more user variables.
@@ -240,16 +234,14 @@ recorded somewhere by that function."
(defcustom remember-save-after-remembering t
"Non-nil means automatically save after remembering."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;;; User Functions:
(defcustom remember-annotation-functions '(buffer-file-name)
"Hook that returns an annotation to be inserted into the remember buffer."
:type 'hook
- :options '(org-remember-annotation buffer-file-name)
- :group 'remember)
+ :options '(org-remember-annotation buffer-file-name))
(defvar remember-annotation nil
"Current annotation.")
@@ -258,13 +250,11 @@ recorded somewhere by that function."
(defcustom remember-before-remember-hook nil
"Functions run before switching to the *Remember* buffer."
- :type 'hook
- :group 'remember)
+ :type 'hook)
(defcustom remember-run-all-annotation-functions-flag nil
"Non-nil means use all annotations returned by
`remember-annotation-functions'."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;;;###autoload
(defun remember (&optional initial)
@@ -337,13 +327,11 @@ With a prefix or a visible region, use the region as
INITIAL."
(defcustom remember-mailbox "~/Mail/remember"
"The file in which to store remember data as mail."
- :type 'file
- :group 'remember)
+ :type 'file)
(defcustom remember-default-priority "medium"
"The default priority for remembered mail messages."
- :type 'string
- :group 'remember)
+ :type 'string)
(defun remember-store-in-mailbox ()
"Store remember data as if it were incoming mail.
@@ -396,19 +384,16 @@ exists) might be changed."
(with-current-buffer buf
(set-visited-file-name
(expand-file-name remember-data-file))))))
- :initialize 'custom-initialize-default
- :group 'remember)
+ :initialize 'custom-initialize-default)
(defcustom remember-leader-text "** "
"The text used to begin each remember item."
- :type 'string
- :group 'remember)
+ :type 'string)
(defcustom remember-time-format "%a %b %d %H:%M:%S %Y"
"The format for time stamp, passed to `format-time-string'.
The default emulates `current-time-string' for backward compatibility."
:type 'string
- :group 'remember
:version "27.1")
(defcustom remember-text-format-function nil
@@ -416,7 +401,6 @@ The default emulates `current-time-string' for backward
compatibility."
The function receives the remembered text as argument and should
return the text to be remembered."
:type '(choice (const nil) function)
- :group 'remember
:version "28.1")
(defun remember-append-to-file ()
@@ -465,16 +449,14 @@ If you want to remember a region, supply a universal
prefix to
"The directory in which to store remember data as files.
Used by `remember-store-in-files'."
:type 'directory
- :version "24.4"
- :group 'remember)
+ :version "24.4")
(defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z"
"Format string for the file name in which to store unprocessed data.
This is passed to `format-time-string'.
Used by `remember-store-in-files'."
:type 'string
- :version "24.4"
- :group 'remember)
+ :version "24.4")
(defun remember-store-in-files ()
"Store remember data in a file in `remember-data-directory'.
@@ -511,8 +493,7 @@ Most useful for remembering things from other applications."
(defcustom remember-diary-file nil
"File for extracted diary entries.
If this is nil, then `diary-file' will be used instead."
- :type '(choice (const :tag "diary-file" nil) file)
- :group 'remember)
+ :type '(choice (const :tag "diary-file" nil) file))
(defvar calendar-date-style) ; calendar.el
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 2b31e7e..c51285d 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -105,10 +105,6 @@
;; Common Lisp stuff
(require 'cl-lib)
-;; Correct wrong declaration.
-(def-edebug-spec push
- (&or [form symbolp] [form gv-place]))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 7799cdb..278cd0c 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -54,20 +54,17 @@
;;;###autoload
(defcustom texinfo-open-quote (purecopy "``")
"String inserted by typing \\[texinfo-insert-quote] to open a quotation."
- :type 'string
- :group 'texinfo)
+ :type 'string)
;;;###autoload
(defcustom texinfo-close-quote (purecopy "''")
"String inserted by typing \\[texinfo-insert-quote] to close a quotation."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-mode-hook nil
"Normal hook run when entering Texinfo mode."
:type 'hook
- :options '(turn-on-auto-fill flyspell-mode)
- :group 'texinfo)
+ :options '(turn-on-auto-fill flyspell-mode))
;;; Autoloads:
@@ -349,8 +346,7 @@ Subexpression 1 is what goes into the corresponding `@end'
statement.")
(defface texinfo-heading
'((t (:inherit font-lock-function-name-face)))
- "Face used for section headings in `texinfo-mode'."
- :group 'texinfo)
+ "Face used for section headings in `texinfo-mode'.")
(defvar texinfo-font-lock-keywords
`(;; All but the first had an OVERRIDE of t.
@@ -962,32 +958,27 @@ to jump to the corresponding spot in the Texinfo source
file."
(defcustom texinfo-texi2dvi-command "texi2dvi"
"Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-texi2dvi-options ""
"Command line options for `texinfo-texi2dvi-command'."
:type 'string
- :group 'texinfo
:version "28.1")
(defcustom texinfo-tex-command "tex"
"Command used by `texinfo-tex-region' to run TeX on a region."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-texindex-command "texindex"
"Command used by `texinfo-texindex' to sort unsorted index files."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-delete-from-print-queue-command "lprm"
"Command string used to delete a job from the line printer queue.
Command is used by \\[texinfo-delete-from-print-queue] based on
number provided by a previous \\[tex-show-print-queue]
command."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defvar texinfo-tex-trailer "@bye"
"String appended after a region sent to TeX by `texinfo-tex-region'.")
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 33a976a..1d90562 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -66,7 +66,6 @@ non-capturing groups can be used for grouping prior to the
part of the regexp
matching the white space). The pattern is matched case-sensitive regardless of
the value of `case-fold-search' setting."
:version "25.1"
- :group 'tildify
:type 'regexp
:safe t)
@@ -90,7 +89,6 @@ by the hard space character.
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
- :group 'tildify
:type '(repeat (cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
(symbol :tag "Major mode"))
@@ -110,7 +108,6 @@ might be used for other modes if compatible encoding is
used.
If nil, current major mode has no way to represent a hard space."
:version "25.1"
- :group 'tildify
:type '(choice (const :tag "Space character (no hard-space representation)"
" ")
(const :tag "No-break space (U+00A0)" "\u00A0")
@@ -133,7 +130,6 @@ STRING defines the hard space, which is inserted at places
defined by
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
- :group 'tildify
:type '(repeat (cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
(symbol :tag "Major mode"))
@@ -164,7 +160,6 @@ or better still:
See `tildify-foreach-ignore-environments' function for other ways to use the
variable."
:version "25.1"
- :group 'tildify
:type 'function)
(defcustom tildify-ignored-environments-alist ()
@@ -183,7 +178,6 @@ MAJOR-MODE defines major mode, for which the item applies.
It can be either:
See `tildify-foreach-ignore-environments' function for description of BEG-REGEX
and END-REGEX."
- :group 'tildify
:type '(repeat
(cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
@@ -416,19 +410,16 @@ If the pattern matches `looking-back', a hard space needs
to be inserted instead
of a space at point. The regexp is always case sensitive, regardless of the
current `case-fold-search' setting."
:version "25.1"
- :group 'tildify
:type 'regexp)
(defcustom tildify-space-predicates '(tildify-space-region-predicate)
"A list of predicate functions for `tildify-space' function."
:version "25.1"
- :group 'tildify
:type '(repeat function))
(defcustom tildify-double-space-undos t
"Weather `tildify-space' should undo hard space when space is typed again."
:version "25.1"
- :group 'tildify
:type 'boolean)
;;;###autoload
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index d072ab1..9c0ed8f 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -133,26 +133,22 @@
'("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
minor-mode-alist "%n" mode-line-process ")%]%-")
"Value of `mode-line-format' for a buffer in two-column minor mode."
- :type 'sexp
- :group 'two-column)
+ :type 'sexp)
(defcustom 2C-other-buffer-hook 'text-mode
"Hook run in new buffer when it is associated with current one."
- :type 'function
- :group 'two-column)
+ :type 'function)
(defcustom 2C-separator ""
"A string inserted between the two columns when merging.
This gets set locally by \\[2C-split]."
- :type 'string
- :group 'two-column)
+ :type 'string)
(put '2C-separator 'permanent-local t)
(defcustom 2C-window-width 40
"The width of the first column. (Must be at least `window-min-width'.)
This value is local for every buffer that sets it."
- :type 'integer
- :group 'two-column)
+ :type 'integer)
(make-variable-buffer-local '2C-window-width)
(put '2C-window-width 'permanent-local t)
@@ -160,13 +156,11 @@ This value is local for every buffer that sets it."
"Base for calculating `fill-column' for a buffer in two-column minor mode.
The value of `fill-column' becomes `2C-window-width' for this buffer
minus this value."
- :type 'integer
- :group 'two-column)
+ :type 'integer)
(defcustom 2C-autoscroll t
"If non-nil, Emacs attempts to keep the two column's buffers aligned."
- :type 'boolean
- :group 'two-column)
+ :type 'boolean)
(defvar 2C-mode-map
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 465d097..957940b 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -199,23 +199,24 @@ Create the thumbnails directory if it does not exist."
If the total size of all files in `thumbs-thumbsdir' is bigger than
`thumbs-thumbsdir-max-size', files are deleted until the max size is
reached."
- (let* ((files-list
- (sort
- (mapcar
- (lambda (f)
- (let ((fattribs-list (file-attributes f)))
- `(,(file-attribute-access-time fattribs-list)
- ,(file-attribute-size fattribs-list)
- ,f)))
- (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
- (lambda (l1 l2) (time-less-p (car l1) (car l2)))))
- (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list))))
- (while (> dirsize thumbs-thumbsdir-max-size)
- (progn
- (message "Deleting file %s" (cadr (cdar files-list))))
- (delete-file (cadr (cdar files-list)))
- (setq dirsize (- dirsize (car (cdar files-list))))
- (setq files-list (cdr files-list)))))
+ (when (file-directory-p thumbs-thumbsdir)
+ (let* ((files-list
+ (sort
+ (mapcar
+ (lambda (f)
+ (let ((fattribs-list (file-attributes f)))
+ `(,(file-attribute-access-time fattribs-list)
+ ,(file-attribute-size fattribs-list)
+ ,f)))
+ (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
+ (lambda (l1 l2) (time-less-p (car l1) (car l2)))))
+ (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list))))
+ (while (> dirsize thumbs-thumbsdir-max-size)
+ (progn
+ (message "Deleting file %s" (cadr (cdar files-list))))
+ (delete-file (cadr (cdar files-list)))
+ (setq dirsize (- dirsize (car (cdar files-list))))
+ (setq files-list (cdr files-list))))))
;; Check the thumbnail directory size and clean it if necessary.
(when thumbs-thumbsdir-auto-clean
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 4381650..a95ea0d 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -1,4 +1,4 @@
-;;; pcvs-parse.el --- the CVS output parser
+;;; pcvs-parse.el --- the CVS output parser -*- lexical-binding: t; -*-
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
@@ -73,12 +73,12 @@ by `$'."
'("status" "add" "commit" "update" "remove" "checkout" "ci")
"List of CVS commands whose output is understood by the parser.")
-(defun cvs-parse-buffer (parse-spec dont-change-disc &optional subdir)
+(defun cvs-parse-buffer (parse-spec dcd &optional subdir)
"Parse current buffer according to PARSE-SPEC.
PARSE-SPEC is a function of no argument advancing the point and returning
either a fileinfo or t (if the matched text should be ignored) or
nil if it didn't match anything.
-DONT-CHANGE-DISC just indicates whether the command was changing the disc
+DCD just indicates whether the command was changing the disc
or not (useful to tell the difference between `cvs-examine' and `cvs-update'
output.
The path names should be interpreted as relative to SUBDIR (defaults
@@ -86,6 +86,7 @@ The path names should be interpreted as relative to SUBDIR
(defaults
Return a list of collected entries, or t if an error occurred."
(goto-char (point-min))
(let ((fileinfos ())
+ (dont-change-disc dcd)
(cvs-current-dir "")
(case-fold-search nil)
(cvs-current-subdir (or subdir "")))
@@ -134,12 +135,12 @@ Match RE and if successful, execute MATCHES."
(defmacro cvs-or (&rest alts)
"Try each one of the ALTS alternatives until one matches."
+ (declare (debug t))
`(let ((-cvs-parse-point (point)))
,(cons 'or
(mapcar (lambda (es)
`(or ,es (ignore (goto-char -cvs-parse-point))))
alts))))
-(def-edebug-spec cvs-or t)
;; This is how parser tables should be executed
(defun cvs-parse-run-table (parse-spec)
@@ -190,9 +191,9 @@ The remaining KEYS are passed directly to
`cvs-create-fileinfo'."
file (cvs-parse-msg) :subtype subtype keys))))
;;;; CVS Process Parser Tables:
-;;;;
-;;;; The table for status and update could actually be merged since they
-;;;; don't conflict. But they don't overlap much either.
+;;
+;; The table for status and update could actually be merged since they
+;; don't conflict. But they don't overlap much either.
(defun cvs-parse-table ()
"Table of message objects for `cvs-parse-process'."
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index c66a4fb..782c799 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1468,12 +1468,12 @@ found, uses VC to try and find the next file with
conflict."
(if (and (buffer-modified-p) buffer-file-name)
(save-buffer))
(vc-find-conflicted-file)
- (if (eq buffer (current-buffer))
- ;; Do nothing: presumably `vc-find-conflicted-file' already
- ;; emitted a message explaining there aren't any more conflicts.
- nil
- (goto-char (point-min))
- (smerge-next)))))))
+ (when (eq buffer (current-buffer))
+ ;; Try to find a conflict marker in current file above the point.
+ (let ((prev-pos (point)))
+ (goto-char (point-min))
+ (unless (ignore-errors (not (smerge-next)))
+ (goto-char prev-pos)))))))))
(provide 'smerge-mode)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 0864e1b..124cb04 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -56,11 +56,10 @@
["Browse At" widget-browse-at t]))
(defcustom widget-browse-mode-hook nil
- "Hook called when entering widget-browse-mode."
- :type 'hook
- :group 'widget-browse)
+ "Hook run after entering `widget-browse-mode'."
+ :type 'hook)
-(defun widget-browse-mode ()
+(define-derived-mode widget-browse-mode special-mode "Widget Browse"
"Major mode for widget browser buffers.
The following commands are available:
@@ -68,15 +67,7 @@ The following commands are available:
\\[widget-forward] Move to next button or editable field.
\\[widget-backward] Move to previous button or editable field.
\\[widget-button-click] Activate button under the mouse pointer.
-\\[widget-button-press] Activate button under point.
-
-Entry to this mode calls the value of `widget-browse-mode-hook'
-if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'widget-browse-mode
- mode-name "Widget")
- (use-local-map widget-browse-mode-map)
- (run-mode-hooks 'widget-browse-mode-hook))
+\\[widget-button-press] Activate button under point.")
(put 'widget-browse-mode 'mode-class 'special)
@@ -190,11 +181,11 @@ The :value of the widget should be the widget to be
browsed."
:action 'widget-browse-action)
(defun widget-browse-action (widget &optional _event)
- ;; Create widget browser for WIDGET's :value.
+ "Create widget browser for :value of WIDGET."
(widget-browse (widget-get widget :value)))
(defun widget-browse-value-create (widget)
- ;; Insert type name.
+ "Insert type name for WIDGET."
(let ((value (widget-get widget :value)))
(cond ((symbolp value)
(insert (symbol-name value)))
@@ -273,8 +264,6 @@ VALUE is assumed to be a list of widgets."
"Minor mode for traversing widgets."
:lighter " Widget")
-;;; The End:
-
(provide 'wid-browse)
;;; wid-browse.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index 2d0a73b..cfd9876 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -10252,6 +10252,28 @@ displaying that processes's buffer."
(define-key ctl-x-4-map "1" 'same-window-prefix)
(define-key ctl-x-4-map "4" 'other-window-prefix)
+(defvar other-window-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "o" 'other-window)
+ map)
+ "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
+(put 'other-window 'repeat-map 'other-window-repeat-map)
+
+(defvar resize-window-repeat-map
+ (let ((map (make-sparse-keymap)))
+ ;; Standard keys:
+ (define-key map "^" 'enlarge-window)
+ (define-key map "}" 'enlarge-window-horizontally)
+ (define-key map "{" 'shrink-window-horizontally)
+ ;; Additional keys:
+ (define-key map "v" 'shrink-window)
+ map)
+ "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
+(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
+(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
+(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
+(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
+
(provide 'window)
;;; window.el ends here
diff --git a/src/buffer.c b/src/buffer.c
index 80c799e..5bd9b37 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -292,6 +292,11 @@ bset_major_mode (struct buffer *b, Lisp_Object val)
b->major_mode_ = val;
}
static void
+bset_local_minor_modes (struct buffer *b, Lisp_Object val)
+{
+ b->local_minor_modes_ = val;
+}
+static void
bset_mark (struct buffer *b, Lisp_Object val)
{
b->mark_ = val;
@@ -893,6 +898,7 @@ CLONE nil means the indirect buffer's state is reset to
default values. */)
bset_file_truename (b, Qnil);
bset_display_count (b, make_fixnum (0));
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
@@ -967,6 +973,7 @@ reset_buffer (register struct buffer *b)
b->clip_changed = 0;
b->prevent_redisplay_optimizations_p = 1;
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
BUF_AUTOSAVE_MODIFF (b) = 0;
b->auto_save_failure_time = 0;
bset_auto_save_file_name (b, Qnil);
@@ -5151,6 +5158,7 @@ init_buffer_once (void)
bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1));
bset_read_only (&buffer_local_flags, make_fixnum (-1));
bset_major_mode (&buffer_local_flags, make_fixnum (-1));
+ bset_local_minor_modes (&buffer_local_flags, make_fixnum (-1));
bset_mode_name (&buffer_local_flags, make_fixnum (-1));
bset_undo_list (&buffer_local_flags, make_fixnum (-1));
bset_mark_active (&buffer_local_flags, make_fixnum (-1));
@@ -5617,6 +5625,12 @@ The default value (normally `fundamental-mode') affects
new buffers.
A value of nil means to use the current buffer's major mode, provided
it is not marked as "special". */);
+ DEFVAR_PER_BUFFER ("local-minor-modes",
+ &BVAR (current_buffer, local_minor_modes),
+ Qnil,
+ doc: /* Minor modes currently active in the current buffer.
+This is a list of symbols, or nil if there are no minor modes active. */);
+
DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
Qnil,
doc: /* Pretty name of current buffer's major mode.
diff --git a/src/buffer.h b/src/buffer.h
index 790291f..24e9c3f 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -338,6 +338,9 @@ struct buffer
/* Symbol naming major mode (e.g., lisp-mode). */
Lisp_Object major_mode_;
+ /* Symbol listing all currently enabled minor modes. */
+ Lisp_Object local_minor_modes_;
+
/* Pretty name of major mode (e.g., "Lisp"). */
Lisp_Object mode_name_;
diff --git a/src/callint.c b/src/callint.c
index d3f49bc..1862463 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -104,7 +104,14 @@ If the string begins with `^' and `shift-select-mode' is
non-nil,
Emacs first calls the function `handle-shift-selection'.
You may use `@', `*', and `^' together. They are processed in the
order that they appear, before reading any arguments.
-usage: (interactive &optional ARG-DESCRIPTOR) */
+
+If MODES is present, it should be a list of mode names (symbols) that
+this command is applicable for. The main effect of this is that
+`M-x TAB' (by default) won't list this command if the current buffer's
+mode doesn't match the list. That is, if either the major mode isn't
+derived from them, or (when it's a minor mode) the mode isn't in effect.
+
+usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */
attributes: const)
(Lisp_Object args)
{
diff --git a/src/data.c b/src/data.c
index 2fa92fe..5177a7c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -978,7 +978,17 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (COMPILEDP (fun))
{
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
- return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* The vector form is the new form, where the first
+ element is the interactive spec, and the second is the
+ command modes. */
+ return list2 (Qinteractive, AREF (form, 0));
+ else
+ /* Old form -- just the interactive spec. */
+ return list2 (Qinteractive, form);
+ }
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@@ -994,10 +1004,75 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure))
- return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
- else if (EQ (funcar, Qlambda))
- return Fassq (Qinteractive, Fcdr (XCDR (fun)));
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ Lisp_Object spec = Fassq (Qinteractive, form);
+ if (NILP (Fcdr (Fcdr (spec))))
+ return spec;
+ else
+ return list2 (Qinteractive, Fcar (Fcdr (spec)));
+ }
+ }
+ return Qnil;
+}
+
+DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
+ doc: /* Return the modes COMMAND is defined for.
+If COMMAND is not a command, the return value is nil.
+The value, if non-nil, is a list of mode name symbols. */)
+ (Lisp_Object command)
+{
+ Lisp_Object fun = indirect_function (command); /* Check cycles. */
+
+ if (NILP (fun))
+ return Qnil;
+
+ fun = command;
+ while (SYMBOLP (fun))
+ fun = Fsymbol_function (fun);
+
+ if (COMPILEDP (fun))
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* New form -- the second element is the command modes. */
+ return AREF (form, 1);
+ else
+ /* Old .elc file -- no command modes. */
+ return Qnil;
+ }
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (fun))
+ {
+ Lisp_Object form
+ = module_function_command_modes (XMODULE_FUNCTION (fun));
+ if (! NILP (form))
+ return form;
+ }
+#endif
+ else if (AUTOLOADP (fun))
+ {
+ Lisp_Object modes = Fnth (make_int (3), fun);
+ if (CONSP (modes))
+ return modes;
+ else
+ return Qnil;
+ }
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ return Fcdr (Fcdr (Fassq (Qinteractive, form)));
+ }
}
return Qnil;
}
@@ -3983,6 +4058,7 @@ syms_of_data (void)
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
+ defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
@@ -4113,6 +4189,7 @@ This variable cannot be set; trying to do so will signal
an error. */);
DEFSYM (Qunlet, "unlet");
DEFSYM (Qset, "set");
DEFSYM (Qset_default, "set-default");
+ DEFSYM (Qcommand_modes, "command-modes");
defsubr (&Sadd_variable_watcher);
defsubr (&Sremove_variable_watcher);
defsubr (&Sget_variable_watchers);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 894dffc..f8fb54c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -549,7 +549,7 @@ struct Lisp_Module_Function
union vectorlike_header header;
/* Fields traced by GC; these must come first. */
- Lisp_Object documentation, interactive_form;
+ Lisp_Object documentation, interactive_form, command_modes;
/* Fields ignored by GC. */
ptrdiff_t min_arity, max_arity;
@@ -646,6 +646,12 @@ module_function_interactive_form (const struct
Lisp_Module_Function *fun)
return fun->interactive_form;
}
+Lisp_Object
+module_function_command_modes (const struct Lisp_Module_Function *fun)
+{
+ return fun->command_modes;
+}
+
static emacs_value
module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
emacs_value *args)
diff --git a/src/eval.c b/src/eval.c
index bf5f699..10e53cf 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1174,21 +1174,23 @@ usage: (catch TAG BODY...) */)
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
+/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
+ throwing t to tag `exit'.
+ 0 means there is no (throw 'exit t) in progress, or it wasn't from
+ a minibuffer which isn't the most nested;
+ N > 0 means the `throw' was done from the minibuffer at level N which
+ wasn't the most nested. */
+EMACS_INT minibuffer_quit_level = 0;
+
Lisp_Object
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
- /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
- throwing t to tag `exit'.
- Value -1 means there is no (throw 'exit t) in progress;
- 0 means the `throw' wasn't done from an active minibuffer;
- N > 0 means the `throw' was done from the minibuffer at level N. */
- static EMACS_INT minibuffer_quit_level = -1;
/* This structure is made part of the chain `catchlist'. */
struct handler *c = push_handler (tag, CATCHER);
if (EQ (tag, Qexit))
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
@@ -1203,22 +1205,16 @@ internal_catch (Lisp_Object tag,
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- if (EQ (tag, Qexit) && EQ (val, Qt))
+ if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0)
/* If we've thrown t to tag `exit' from within a minibuffer, we
exit all minibuffers more deeply nested than the current
one. */
{
- EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
- if (mini_depth && mini_depth != minibuffer_quit_level)
- {
- if (minibuffer_quit_level == -1)
- minibuffer_quit_level = mini_depth;
- if (minibuffer_quit_level
- && (minibuf_level > minibuffer_quit_level))
- Fthrow (Qexit, Qt);
- }
+ if (minibuf_level > minibuffer_quit_level
+ && !NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ Fthrow (Qexit, Qt);
else
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
}
return val;
}
@@ -2177,14 +2173,21 @@ then strings and vectors are not accepted. */)
DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
doc: /* Define FUNCTION to autoload from FILE.
FUNCTION is a symbol; FILE is a file name string to pass to `load'.
+
Third arg DOCSTRING is documentation for the function.
-Fourth arg INTERACTIVE if non-nil says function can be called interactively.
+
+Fourth arg INTERACTIVE if non-nil says function can be called
+interactively. If INTERACTIVE is a list, it is interpreted as a list
+of modes the function is applicable for.
+
Fifth arg TYPE indicates the type of the object:
nil or omitted says FUNCTION is a function,
`keymap' says FUNCTION is really a keymap, and
`macro' or t says FUNCTION is really a macro.
+
Third through fifth args give info about the real definition.
They default to nil.
+
If FUNCTION is already defined other than as an autoload,
this does nothing and returns nil. */)
(Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object
interactive, Lisp_Object type)
diff --git a/src/frame.c b/src/frame.c
index 635fc94..a62347c 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3890,7 +3890,7 @@ frame_float (struct frame *f, Lisp_Object val, enum
frame_float_type what,
Lisp_Object frame;
XSETFRAME (frame, f);
- monitor_attributes = Fcar (call1
(Qdisplay_monitor_attributes_list, frame));
+ monitor_attributes = call1 (Qframe_monitor_attributes, frame);
if (NILP (monitor_attributes))
{
/* No monitor attributes available. */
@@ -5890,7 +5890,7 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
- DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
+ DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
diff --git a/src/image.c b/src/image.c
index a124cf9..8137dbe 100644
--- a/src/image.c
+++ b/src/image.c
@@ -135,6 +135,12 @@ typedef struct ns_bitmap_record Bitmap_Record;
# define COLOR_TABLE_SUPPORT 1
#endif
+#if defined HAVE_NS
+# define FRAME_SCALE_FACTOR(f) ns_frame_scale_factor (f)
+#else
+# define FRAME_SCALE_FACTOR(f) 1;
+#endif
+
static void image_disable_image (struct frame *, struct image *);
static void image_edge_detection (struct frame *, struct image *, Lisp_Object,
Lisp_Object);
@@ -2207,8 +2213,8 @@ image_set_transform (struct frame *f, struct image *img)
/* SVGs are pre-scaled to the correct size. */
if (EQ (image_spec_value (img->spec, QCtype, NULL), Qsvg))
{
- width = img->width;
- height = img->height;
+ width = img->width / FRAME_SCALE_FACTOR (f);
+ height = img->height / FRAME_SCALE_FACTOR (f);
}
else
#endif
@@ -10008,6 +10014,9 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
compute_image_size (viewbox_width, viewbox_height, img->spec,
&width, &height);
+ width *= FRAME_SCALE_FACTOR (f);
+ height *= FRAME_SCALE_FACTOR (f);
+
if (! check_image_size (f, width, height))
{
image_size_error ();
diff --git a/src/json.c b/src/json.c
index 2901a20..3f1d27a 100644
--- a/src/json.c
+++ b/src/json.c
@@ -327,13 +327,14 @@ struct json_configuration {
Lisp_Object false_object;
};
-static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf);
+static json_t *lisp_to_json (Lisp_Object,
+ const struct json_configuration *conf);
-/* Convert a Lisp object to a toplevel JSON object (array or object). */
+/* Convert a Lisp object to a nonscalar JSON object (array or object). */
static json_t *
-lisp_to_json_toplevel_1 (Lisp_Object lisp,
- struct json_configuration *conf)
+lisp_to_json_nonscalar_1 (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
json_t *json;
ptrdiff_t count;
@@ -448,16 +449,17 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
return json;
}
-/* Convert LISP to a toplevel JSON object (array or object). Signal
+/* Convert LISP to a nonscalar JSON object (array or object). Signal
an error of type `wrong-type-argument' if LISP is not a vector,
hashtable, alist, or plist. */
static json_t *
-lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json_nonscalar (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
if (++lisp_eval_depth > max_lisp_eval_depth)
xsignal0 (Qjson_object_too_deep);
- json_t *json = lisp_to_json_toplevel_1 (lisp, conf);
+ json_t *json = lisp_to_json_nonscalar_1 (lisp, conf);
--lisp_eval_depth;
return json;
}
@@ -467,7 +469,7 @@ lisp_to_json_toplevel (Lisp_Object lisp, struct
json_configuration *conf)
JSON object. */
static json_t *
-lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json (Lisp_Object lisp, const struct json_configuration *conf)
{
if (EQ (lisp, conf->null_object))
return json_check (json_null ());
@@ -499,7 +501,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration
*conf)
}
/* LISP now must be a vector, hashtable, alist, or plist. */
- return lisp_to_json_toplevel (lisp, conf);
+ return lisp_to_json_nonscalar (lisp, conf);
}
static void
@@ -557,15 +559,15 @@ DEFUN ("json-serialize", Fjson_serialize,
Sjson_serialize, 1, MANY,
NULL,
doc: /* Return the JSON representation of OBJECT as a string.
-OBJECT must be a vector, hashtable, alist, or plist and its elements
-can recursively contain the Lisp equivalents to the JSON null and
-false values, t, numbers, strings, or other vectors hashtables, alists
-or plists. t will be converted to the JSON true value. Vectors will
-be converted to JSON arrays, whereas hashtables, alists and plists are
-converted to JSON objects. Hashtable keys must be strings without
-embedded null characters and must be unique within each object. Alist
-and plist keys must be symbols; if a key is duplicate, the first
-instance is used.
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values. t will
+be converted to the JSON true value. Vectors will be converted to
+JSON arrays, whereas hashtables, alists and plists are converted to
+JSON objects. Hashtable keys must be strings without embedded null
+characters and must be unique within each object. Alist and plist
+keys must be symbols; if a key is duplicate, the first instance is
+used.
The Lisp equivalents to the JSON null and false values are
configurable in the arguments ARGS, a list of keyword/argument pairs:
@@ -603,12 +605,10 @@ usage: (json-serialize OBJECT &rest ARGS) */)
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
- json_t *json = lisp_to_json_toplevel (args[0], &conf);
+ json_t *json = lisp_to_json (args[0], &conf);
record_unwind_protect_ptr (json_release_object, json);
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- char *string = json_dumps (json, JSON_COMPACT);
+ char *string = json_dumps (json, JSON_COMPACT | JSON_ENCODE_ANY);
if (string == NULL)
json_out_of_memory ();
record_unwind_protect_ptr (json_free, string);
@@ -723,12 +723,10 @@ usage: (json-insert OBJECT &rest ARGS) */)
move_gap_both (PT, PT_BYTE);
struct json_insert_data data;
data.inserted_bytes = 0;
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- int status
- /* Could have used json_dumpb, but that became available only in
- Jansson 2.10, whereas we want to support 2.7 and upward. */
- = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+ /* Could have used json_dumpb, but that became available only in
+ Jansson 2.10, whereas we want to support 2.7 and upward. */
+ int status = json_dump_callback (json, json_insert_callback, &data,
+ JSON_COMPACT | JSON_ENCODE_ANY);
if (status == -1)
{
if (CONSP (data.error))
@@ -791,7 +789,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
/* Convert a JSON object to a Lisp object. */
static Lisp_Object ARG_NONNULL ((1))
-json_to_lisp (json_t *json, struct json_configuration *conf)
+json_to_lisp (json_t *json, const struct json_configuration *conf)
{
switch (json_typeof (json))
{
@@ -932,12 +930,12 @@ DEFUN ("json-parse-string", Fjson_parse_string,
Sjson_parse_string, 1, MANY,
NULL,
doc: /* Parse the JSON STRING into a Lisp object.
This is essentially the reverse operation of `json-serialize', which
-see. The returned object will be a vector, list, hashtable, alist, or
-plist. Its elements will be the JSON null value, the JSON false
-value, t, numbers, strings, or further vectors, hashtables, alists, or
-plists. If there are duplicate keys in an object, all but the last
-one are ignored. If STRING doesn't contain a valid JSON object, this
-function signals an error of type `json-parse-error'.
+see. The returned object will be the JSON null value, the JSON false
+value, t, a number, a string, a vector, a list, a hashtable, an alist,
+or a plist. Its elements will be further objects of these types. If
+there are duplicate keys in an object, all but the last one are
+ignored. If STRING doesn't contain a valid JSON object, this function
+signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
@@ -982,7 +980,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
json_parse_args (nargs - 1, args + 1, &conf, true);
json_error_t error;
- json_t *object = json_loads (SSDATA (encoded), 0, &error);
+ json_t *object
+ = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error);
if (object == NULL)
json_parse_error (&error);
@@ -1078,8 +1077,10 @@ usage: (json-parse-buffer &rest args) */)
ptrdiff_t point = PT_BYTE;
struct json_read_buffer_data data = {.point = point};
json_error_t error;
- json_t *object = json_load_callback (json_read_buffer_callback, &data,
- JSON_DISABLE_EOF_CHECK, &error);
+ json_t *object
+ = json_load_callback (json_read_buffer_callback, &data,
+ JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK,
+ &error);
if (object == NULL)
json_parse_error (&error);
diff --git a/src/lisp.h b/src/lisp.h
index 1d4f16b..fcdf8e2 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4110,6 +4110,7 @@ intern_c_string (const char *str)
}
/* Defined in eval.c. */
+extern EMACS_INT minibuffer_quit_level;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
@@ -4242,6 +4243,8 @@ extern Lisp_Object module_function_documentation
(struct Lisp_Module_Function const *);
extern Lisp_Object module_function_interactive_form
(const struct Lisp_Module_Function *);
+extern Lisp_Object module_function_command_modes
+ (const struct Lisp_Module_Function *);
extern module_funcptr module_function_address
(struct Lisp_Module_Function const *);
extern void *module_function_data (const struct Lisp_Module_Function *);
@@ -4391,6 +4394,7 @@ extern void syms_of_casetab (void);
/* Defined in keyboard.c. */
+extern EMACS_INT command_loop_level;
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern void cancel_echoing (void);
diff --git a/src/minibuf.c b/src/minibuf.c
index 949c3d9..4b1f4b1 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -41,6 +41,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
minibuffer recursions are encountered. */
Lisp_Object Vminibuffer_list;
+Lisp_Object Vcommand_loop_level_list;
/* Data to remember during recursive minibuffer invocations. */
@@ -64,6 +65,8 @@ static Lisp_Object minibuf_prompt;
static ptrdiff_t minibuf_prompt_width;
static Lisp_Object nth_minibuffer (EMACS_INT depth);
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth);
+static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth);
/* Return TRUE when a frame switch causes a minibuffer on the old
@@ -181,7 +184,12 @@ void move_minibuffer_onto_frame (void)
set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
minibuf_window = sf->minibuffer_window;
if (of != sf)
- set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
+ {
+ Lisp_Object temp = get_minibuffer (0);
+
+ set_window_buffer (of->minibuffer_window, temp, 0, 0);
+ set_minibuffer_mode (temp, 0);
+ }
}
}
@@ -389,6 +397,21 @@ No argument or nil as argument means use the current
buffer as BUFFER. */)
: Qnil;
}
+DEFUN ("minibuffer-innermost-command-loop-p",
Fminibuffer_innermost_command_loop_p,
+ Sminibuffer_innermost_command_loop_p, 0, 1, 0,
+ doc: /* Return t if BUFFER is a minibuffer at the current command loop
level.
+No argument or nil as argument means use the current buffer as BUFFER. */)
+ (Lisp_Object buffer)
+{
+ EMACS_INT depth;
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ depth = this_minibuffer_depth (buffer);
+ return depth && minibuf_c_loop_level (depth) == command_loop_level
+ ? Qt
+ : Qnil;
+}
+
/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
BUFFER isn't such a thing. If BUFFER is nil, this means use the current
buffer. */
@@ -420,12 +443,17 @@ confirm the aborting of the current minibuffer and all
contained ones. */)
if (!minibuf_depth)
error ("Not in a minibuffer");
+ if (NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ error ("Not in most nested command loop");
if (minibuf_depth < minibuf_level)
{
array[0] = fmt;
array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
if (!NILP (Fyes_or_no_p (Fformat (2, array))))
- Fthrow (Qexit, Qt);
+ {
+ minibuffer_quit_level = minibuf_depth;
+ Fthrow (Qexit, Qt);
+ }
}
else
Fthrow (Qexit, Qt);
@@ -508,6 +536,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
Lisp_Object calling_frame = selected_frame;
+ Lisp_Object calling_window = selected_window;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
@@ -598,7 +627,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
if (minibuf_level > 1
&& minibuf_moves_frame_when_opened ()
- && !minibuf_follows_frame ())
+ && (!minibuf_follows_frame ()
+ || (!EQ (mini_frame, selected_frame))))
{
EMACS_INT i;
@@ -607,8 +637,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0);
}
- record_unwind_protect_void (choose_minibuf_frame);
-
record_unwind_protect (restore_window_configuration,
Fcons (Qt, Fcurrent_window_configuration (Qnil)));
@@ -640,7 +668,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
minibuf_save_list
= Fcons (Voverriding_local_map,
Fcons (minibuf_window,
- minibuf_save_list));
+ Fcons (calling_frame,
+ Fcons (calling_window,
+ minibuf_save_list))));
minibuf_save_list
= Fcons (minibuf_prompt,
Fcons (make_fixnum (minibuf_prompt_width),
@@ -694,6 +724,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
/* Switch to the minibuffer. */
minibuffer = get_minibuffer (minibuf_level);
+ set_minibuffer_mode (minibuffer, minibuf_level);
Fset_buffer (minibuffer);
/* Defeat (setq-default truncate-lines t), since truncated lines do
@@ -738,6 +769,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
where there is an active minibuffer.
Set them to point to ` *Minibuf-0*', which is always empty. */
empty_minibuf = get_minibuffer (0);
+ set_minibuffer_mode (empty_minibuf, 0);
FOR_EACH_FRAME (dummy, frame)
{
@@ -837,20 +869,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
recursive_edit_1 ();
- /* We've exited the recursive edit without an error, so switch the
- current window away from the expired minibuffer window. */
- {
- Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
- /* PREV can be on a different frame when we have a minibuffer only
- frame, the other frame's minibuffer window is MINIBUF_WINDOW,
- and its "focus window" is also MINIBUF_WINDOW. */
- while (!EQ (prev, minibuf_window)
- && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
- prev = Fprevious_window (prev, Qnil, Qnil);
- if (!EQ (prev, minibuf_window))
- Fset_frame_selected_window (selected_frame, prev, Qnil);
- }
-
/* If cursor is on the minibuffer line,
show the user we have exited by putting it in column 0. */
if (XWINDOW (minibuf_window)->cursor.vpos >= 0
@@ -959,11 +977,16 @@ Lisp_Object
get_minibuffer (EMACS_INT depth)
{
Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
+ Lisp_Object cll_tail = Fnthcdr (make_fixnum (depth),
+ Vcommand_loop_level_list);
if (NILP (tail))
{
tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
+ cll_tail = list1 (Qnil);
+ Vcommand_loop_level_list = nconc2 (Vcommand_loop_level_list, cll_tail);
}
+ XSETCAR (cll_tail, make_fixnum (depth ? command_loop_level : 0));
Lisp_Object buf = Fcar (tail);
if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
@@ -973,7 +996,6 @@ get_minibuffer (EMACS_INT depth)
buf = Fget_buffer_create (lname, Qnil);
/* Do this before set_minibuffer_mode. */
XSETCAR (tail, buf);
- set_minibuffer_mode (buf, depth);
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
Fbuffer_enable_undo (buf);
@@ -985,12 +1007,19 @@ get_minibuffer (EMACS_INT depth)
while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- set_minibuffer_mode (buf, depth);
}
return buf;
}
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth)
+{
+ Lisp_Object cll = Fnth (make_fixnum (depth), Vcommand_loop_level_list);
+ if (FIXNUMP (cll))
+ return XFIXNUM (cll);
+ return 0;
+}
+
static void
run_exit_minibuf_hook (void)
{
@@ -1004,17 +1033,16 @@ static void
read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
- Lisp_Object window;
+ Lisp_Object calling_frame;
+ Lisp_Object calling_window;
Lisp_Object future_mini_window;
- /* If this was a recursive minibuffer,
- tie the minibuffer window back to the outer level minibuffer buffer. */
- minibuf_level--;
-
- window = minibuf_window;
/* To keep things predictable, in case it matters, let's be in the
- minibuffer when we reset the relevant variables. */
- Fset_buffer (XWINDOW (window)->contents);
+ minibuffer when we reset the relevant variables. Don't depend on
+ `minibuf_window' here. This could by now be the mini-window of any
+ frame. */
+ Fset_buffer (nth_minibuffer (minibuf_level));
+ minibuf_level--;
/* Restore prompt, etc, from outer minibuffer level. */
Lisp_Object key_vec = Fcar (minibuf_save_list);
@@ -1042,6 +1070,10 @@ read_minibuf_unwind (void)
#endif
future_mini_window = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_frame = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_window = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
/* Erase the minibuffer we were using at this level. */
{
@@ -1059,7 +1091,7 @@ read_minibuf_unwind (void)
mini-window back to its normal size. */
if (minibuf_level == 0
|| !EQ (selected_frame, WINDOW_FRAME (XWINDOW (future_mini_window))))
- resize_mini_window (XWINDOW (window), 0);
+ resize_mini_window (XWINDOW (minibuf_window), 0);
/* Deal with frames that should be removed when exiting the
minibuffer. */
@@ -1090,6 +1122,24 @@ read_minibuf_unwind (void)
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
+
+ /* We've exited the recursive edit, so switch the current windows
+ away from the expired minibuffer window, both in the current
+ minibuffer's frame and the original calling frame. */
+ choose_minibuf_frame ();
+ if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame))
+ {
+ Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
+ /* PREV can be on a different frame when we have a minibuffer only
+ frame, the other frame's minibuffer window is MINIBUF_WINDOW,
+ and its "focus window" is also MINIBUF_WINDOW. */
+ if (!EQ (prev, minibuf_window)
+ && EQ (WINDOW_FRAME (XWINDOW (prev)),
+ WINDOW_FRAME (XWINDOW (minibuf_window))))
+ Fset_frame_selected_window (selected_frame, prev, Qnil);
+ }
+ else
+ Fset_frame_selected_window (calling_frame, calling_window, Qnil);
}
@@ -2137,6 +2187,7 @@ void
init_minibuf_once (void)
{
staticpro (&Vminibuffer_list);
+ staticpro (&Vcommand_loop_level_list);
pdumper_do_now_and_after_load (init_minibuf_once_for_pdumper);
}
@@ -2150,6 +2201,7 @@ init_minibuf_once_for_pdumper (void)
restore from a dump file. pdumper doesn't try to preserve
frames, windows, and so on, so reset everything related here. */
Vminibuffer_list = Qnil;
+ Vcommand_loop_level_list = Qnil;
minibuf_level = 0;
minibuf_prompt = Qnil;
minibuf_save_list = Qnil;
@@ -2380,6 +2432,7 @@ instead. */);
defsubr (&Sminibufferp);
defsubr (&Sinnermost_minibuffer_p);
+ defsubr (&Sminibuffer_innermost_command_loop_p);
defsubr (&Sabort_minibuffers);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
diff --git a/src/nsterm.h b/src/nsterm.h
index eae1d07..017c239 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1252,6 +1252,7 @@ struct input_event;
extern void ns_init_events (struct input_event *);
extern void ns_finish_events (void);
+extern double ns_frame_scale_factor (struct frame *);
#ifdef NS_IMPL_GNUSTEP
extern char gnustep_base_version[]; /* version tracking */
diff --git a/src/nsterm.m b/src/nsterm.m
index 1b23286..b0cf595 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -857,6 +857,17 @@ ns_row_rect (struct window *w, struct glyph_row *row,
}
+double
+ns_frame_scale_factor (struct frame *f)
+{
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060
+ return [[FRAME_NS_VIEW (f) window] backingScaleFactor];
+#else
+ return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor];
+#endif
+}
+
+
/* ==========================================================================
Focus (clipping) and screen update
@@ -7339,6 +7350,8 @@ not_in_argv (NSString *arg)
[surface release];
surface = nil;
+
+ [self setNeedsDisplay:YES];
}
#endif
@@ -7510,6 +7523,16 @@ not_in_argv (NSString *arg)
[self initWithFrame: r];
[self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable];
+#ifdef NS_DRAW_TO_BUFFER
+ /* These settings mean AppKit will retain the contents of the frame
+ on resize. Unfortunately it also means the frame will not be
+ automatically marked for display, but we can do that ourselves in
+ viewDidResize. */
+ [self setLayerContentsRedrawPolicy:
+ NSViewLayerContentsRedrawOnSetNeedsDisplay];
+ [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
+#endif
+
FRAME_NS_VIEW (f) = self;
emacsframe = f;
#ifdef NS_IMPL_COCOA
@@ -8452,6 +8475,34 @@ not_in_argv (NSString *arg)
}
+#ifdef NS_IMPL_COCOA
+/* If the frame has been garbaged but the toolkit wants to draw, for
+ example when resizing the frame, we end up with a blank screen.
+ Sometimes this results in an unpleasant flicker, so try to
+ redisplay before drawing. */
+- (void)viewWillDraw
+{
+ if (FRAME_GARBAGED_P (emacsframe)
+ && !redisplaying_p)
+ {
+ /* If there is IO going on when redisplay is run here Emacs
+ crashes. I think it's because this code will always be run
+ within the run loop and for whatever reason processing input
+ is dangerous. This technique was stolen wholesale from
+ nsmenu.m and seems to work. */
+ bool owfi = waiting_for_input;
+ waiting_for_input = 0;
+ block_input ();
+
+ redisplay ();
+
+ unblock_input ();
+ waiting_for_input = owfi;
+ }
+}
+#endif
+
+
#ifdef NS_DRAW_TO_BUFFER
- (BOOL)wantsUpdateLayer
{
@@ -8469,6 +8520,13 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView updateLayer]");
+ /* We run redisplay on frames that are garbaged, but marked for
+ display, before updateLayer is called so if the frame is still
+ garbaged that means the last redisplay must have refused to
+ update the frame. */
+ if (FRAME_GARBAGED_P (emacsframe))
+ return;
+
/* This can fail to update the screen if the same surface is
provided twice in a row, even if its contents have changed.
There's a private method, -[CALayer setContentsChanged], that we
diff --git a/src/pdumper.c b/src/pdumper.c
index 1f1f6e0..f053143 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2712,7 +2712,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB
+#if CHECK_STRUCTS && !defined HASH_buffer_F8FE65D42F
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2723,6 +2723,7 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
buffer->window_count = 0;
else
eassert (buffer->window_count == -1);
+ buffer->local_minor_modes_ = Qnil;
buffer->last_selected_window_ = Qnil;
buffer->display_count_ = make_fixnum (0);
buffer->clip_changed = 0;
diff --git a/src/window.h b/src/window.h
index 79eb44e..b6f88e8 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1120,10 +1120,6 @@ void set_window_buffer (Lisp_Object window, Lisp_Object
buffer,
extern Lisp_Object echo_area_window;
-/* Depth in recursive edits. */
-
-extern EMACS_INT command_loop_level;
-
/* Non-zero if we should redraw the mode lines on the next redisplay.
Usually set to a unique small integer so we can track the main causes of
full redisplays in `redisplay--mode-lines-cause'. */
diff --git a/src/xdisp.c b/src/xdisp.c
index fb8eaf4..f86d352 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9227,10 +9227,10 @@ move_it_in_display_line_to (struct it *it,
|| prev_method == GET_FROM_STRING)
/* Passed TO_CHARPOS from left to right. */
&& ((prev_pos < to_charpos
- && IT_CHARPOS (*it) > to_charpos)
+ && IT_CHARPOS (*it) >= to_charpos)
/* Passed TO_CHARPOS from right to left. */
|| (prev_pos > to_charpos
- && IT_CHARPOS (*it) < to_charpos)))))
+ && IT_CHARPOS (*it) <= to_charpos)))))
{
if (it->line_wrap != WORD_WRAP || wrap_it.sp < 0)
{
@@ -10049,7 +10049,10 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int
to_x, int to_y, int to_vpos
it->continuation_lines_width = 0;
reseat_at_next_visible_line_start (it, false);
if ((op & MOVE_TO_POS) != 0
- && IT_CHARPOS (*it) > to_charpos)
+ && (IT_CHARPOS (*it) > to_charpos
+ || (IT_CHARPOS (*it) == to_charpos
+ && to_charpos == ZV
+ && FETCH_BYTE (ZV_BYTE - 1) != '\n')))
{
reached = 9;
goto out;
diff --git a/src/xfns.c b/src/xfns.c
index 481ee0e..d906448 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -4599,7 +4599,7 @@ On MS Windows, this just returns nil. */)
return Qnil;
}
-#if !defined USE_GTK || !defined HAVE_GTK3
+#if !(defined USE_GTK && defined HAVE_GTK3)
/* Store the geometry of the workarea on display DPYINFO into *RECT.
Return false if and only if the workarea information cannot be
@@ -4662,6 +4662,9 @@ x_get_net_workarea (struct x_display_info *dpyinfo,
XRectangle *rect)
return result;
}
+#endif /* !(USE_GTK && HAVE_GTK3) */
+
+#ifndef USE_GTK
/* Return monitor number where F is "most" or closest to. */
static int
@@ -4877,6 +4880,8 @@ x_get_monitor_attributes_xrandr (struct x_display_info
*dpyinfo)
pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window);
#endif
+#undef RANDR13_LIBRARY
+
for (i = 0; i < n_monitors; ++i)
{
XRROutputInfo *info = XRRGetOutputInfo (dpy, resources,
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
index 7b86b55..2f7026a 100644
---
a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
+++
b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
@@ -1 +1 @@
-&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt
+&%%(diary-anniversary 8 15 2003) Maria Himmelfahrt
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
index 3b82ec0..fa652db 100644
---
a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
+++
b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
@@ -1 +1 @@
-&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt
+&%%(diary-anniversary 15 8 2003) Maria Himmelfahrt
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
index 7fc9947..803dd36 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
@@ -1 +1 @@
-&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt
+&%%(diary-anniversary 2003 8 15) Maria Himmelfahrt
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
index a54780b..bc485d8 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
@@ -1 +1 @@
-&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 9 19 2002) 09:00-11:30 rrule yearly
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
index a4bd81d..42509d4 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
@@ -1 +1 @@
-&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 19 9 2002) 09:00-11:30 rrule yearly
diff --git
a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
index 65a7abe..72fe6e1 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
@@ -1 +1 @@
-&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 2002 9 19) 09:00-11:30 rrule yearly
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 7993a1f..61d3c11 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -87,7 +87,7 @@
(let* ((calendar-date-style 'iso)
result)
(setq result (icalendar--convert-anniversary-to-ical
- "" "%%(diary-anniversary 1964 6 30) g"))
+ "" "%%(diary-anniversary 1963 6 30) g"))
(should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:19640630"
@@ -353,7 +353,7 @@ END:VTIMEZONE
(let ((calendar-date-style 'iso))
;; numeric iso
(should (string= "20080511"
- (icalendar--datestring-to-isodate "2008 05 11")))
+ (icalendar--datestring-to-isodate "2008 05 11")))
(should (string= "20080531"
(icalendar--datestring-to-isodate "2008 05 31")))
(should (string= "20080602"
@@ -384,7 +384,19 @@ END:VTIMEZONE
(should (string= "20081105"
(icalendar--datestring-to-isodate "05 Nov 2008")))
(should (string= "20081105"
- (icalendar--datestring-to-isodate "2008 Nov 05")))))
+ (icalendar--datestring-to-isodate "2008 Nov 05")))
+
+ ;; non-numeric with day-shift and year-shift
+ (setq calendar-date-style nil) ;not necessary for conversion
+ (should (string= "20210212"
+ (icalendar--datestring-to-isodate "2021 Feb 11" 1)))
+ (should (string= "20210131"
+ (icalendar--datestring-to-isodate "2021 Feb 11" -11)))
+ (should (string= "20200211"
+ (icalendar--datestring-to-isodate "2021 Feb 11" nil -1)))
+ (should (string= "21010211"
+ (icalendar--datestring-to-isodate "2021 Feb 11" nil 80)))
+ ))
(ert-deftest icalendar--first-weekday-of-year ()
"Test method for `icalendar-first-weekday-of-year'."
@@ -569,10 +581,10 @@ END:VEVENT
;; testcase: dtstart is mandatory
(should (null (icalendar--convert-tz-offset
- '((TZOFFSETFROM nil "+0100")
- (TZOFFSETTO nil "+0200")
- (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU"))
- t)))
+ '((TZOFFSETFROM nil "+0100")
+ (TZOFFSETTO nil "+0200")
+ (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU"))
+ t)))
;; FIXME: rrule and rdate are NOT mandatory! Must fix code
;; before activating these testcases
@@ -830,18 +842,18 @@ SUMMARY:yearly no time
"Perform export test."
;; anniversaries
(icalendar-tests--test-export
- "%%(diary-anniversary 1989 10 3) anniversary no time"
- "%%(diary-anniversary 3 10 1989) anniversary no time"
- "%%(diary-anniversary 10 3 1989) anniversary no time"
+ "%%(diary-anniversary 1988 10 3) anniversary no time"
+ "%%(diary-anniversary 3 10 1988) anniversary no time"
+ "%%(diary-anniversary 10 3 1988) anniversary no time"
"DTSTART;VALUE=DATE:19891003
DTEND;VALUE=DATE:19891004
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03
SUMMARY:anniversary no time
")
(icalendar-tests--test-export
- "%%(diary-anniversary 1989 10 3) 19:00-20:00 anniversary with time"
- "%%(diary-anniversary 3 10 1989) 19:00-20:00 anniversary with time"
- "%%(diary-anniversary 10 3 1989) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 1988 10 3) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 3 10 1988) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 10 3 1988) 19:00-20:00 anniversary with time"
"DTSTART;VALUE=DATE-TIME:19891003T190000
DTEND;VALUE=DATE-TIME:19891004T200000
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03
@@ -891,12 +903,12 @@ SUMMARY:no alarm
"
nil)
- ;; 10 minutes in advance, audio
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 audio alarm"
- "17 Nov 2014 19:30 audio alarm"
- "Nov 17 2014 19:30 audio alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 10 minutes in advance, audio
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 audio alarm"
+ "17 Nov 2014 19:30 audio alarm"
+ "Nov 17 2014 19:30 audio alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:audio alarm
BEGIN:VALARM
@@ -904,14 +916,14 @@ ACTION:AUDIO
TRIGGER:-PT10M
END:VALARM
"
- '(10 ((audio))))
+ '(10 ((audio))))
- ;; 20 minutes in advance, display
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 display alarm"
- "17 Nov 2014 19:30 display alarm"
- "Nov 17 2014 19:30 display alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 20 minutes in advance, display
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 display alarm"
+ "17 Nov 2014 19:30 display alarm"
+ "Nov 17 2014 19:30 display alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:display alarm
BEGIN:VALARM
@@ -920,14 +932,14 @@ TRIGGER:-PT20M
DESCRIPTION:display alarm
END:VALARM
"
- '(20 ((display))))
+ '(20 ((display))))
- ;; 66 minutes in advance, email
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 email alarm"
- "17 Nov 2014 19:30 email alarm"
- "Nov 17 2014 19:30 email alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 66 minutes in advance, email
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 email alarm"
+ "17 Nov 2014 19:30 email alarm"
+ "Nov 17 2014 19:30 email alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:email alarm
BEGIN:VALARM
@@ -939,14 +951,14 @@ ATTENDEE:MAILTO:att.one@email.com
ATTENDEE:MAILTO:att.two@email.com
END:VALARM
"
- '(66 ((email ("att.one@email.com" "att.two@email.com")))))
+ '(66 ((email ("att.one@email.com" "att.two@email.com")))))
- ;; 2 minutes in advance, all alarms
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 all alarms"
- "17 Nov 2014 19:30 all alarms"
- "Nov 17 2014 19:30 all alarms"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 2 minutes in advance, all alarms
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 all alarms"
+ "17 Nov 2014 19:30 all alarms"
+ "Nov 17 2014 19:30 all alarms"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:all alarms
BEGIN:VALARM
@@ -967,7 +979,7 @@ TRIGGER:-PT2M
DESCRIPTION:all alarms
END:VALARM
"
- '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio)
(display)))))
+ '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display)))))
;; ======================================================================
;; Import tests
@@ -1247,7 +1259,7 @@ Argument INPUT icalendar event string."
(find-file temp-ics)
(goto-char (point-min))
;;(when (re-search-forward "\nUID:.*\n" nil t)
- ;;(replace-match "\n"))
+ ;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min)
(point-max))))
(should (string= org-input cycled)))))
;; clean up
@@ -1276,8 +1288,8 @@ DESCRIPTION:beschreibung!
LOCATION:nowhere
ORGANIZER:ulf
")
- (icalendar-tests--test-cycle
- "UID:4711
+ (icalendar-tests--test-cycle
+ "UID:4711
DTSTART;VALUE=DATE:19190909
DTEND;VALUE=DATE:19190910
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09
@@ -1377,7 +1389,7 @@ SUMMARY:ff")
"
>>> anniversaries:
-%%(diary-anniversary 3 28 1991) aa birthday (%d years old)"
+%%(diary-anniversary 3 28 1990) aa birthday (%d years old)"
"DTSTART;VALUE=DATE:19910328
DTEND;VALUE=DATE:19910329
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=03;BYMONTHDAY=28
@@ -1387,7 +1399,7 @@ SUMMARY:aa birthday (%d years old)
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 5 17 1957) bb birthday (%d years old)"
+ "%%(diary-anniversary 5 17 1956) bb birthday (%d years old)"
"DTSTART;VALUE=DATE:19570517
DTEND;VALUE=DATE:19570518
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=05;BYMONTHDAY=17
@@ -1396,7 +1408,7 @@ SUMMARY:bb birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 6 8 1997) cc birthday (%d years old)"
+ "%%(diary-anniversary 6 8 1996) cc birthday (%d years old)"
"DTSTART;VALUE=DATE:19970608
DTEND;VALUE=DATE:19970609
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=08
@@ -1405,7 +1417,7 @@ SUMMARY:cc birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 7 22 1983) dd (%d years ago...!)"
+ "%%(diary-anniversary 7 22 1982) dd (%d years ago...!)"
"DTSTART;VALUE=DATE:19830722
DTEND;VALUE=DATE:19830723
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=07;BYMONTHDAY=22
@@ -1414,7 +1426,7 @@ SUMMARY:dd (%d years ago...!)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 8 1 1988) ee birthday (%d years old)"
+ "%%(diary-anniversary 8 1 1987) ee birthday (%d years old)"
"DTSTART;VALUE=DATE:19880801
DTEND;VALUE=DATE:19880802
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=08;BYMONTHDAY=01
@@ -1423,7 +1435,7 @@ SUMMARY:ee birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 9 21 1957) ff birthday (%d years old)"
+ "%%(diary-anniversary 9 21 1956) ff birthday (%d years old)"
"DTSTART;VALUE=DATE:19570921
DTEND;VALUE=DATE:19570922
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=21
diff --git a/test/lisp/emacs-lisp/bindat-tests.el
b/test/lisp/emacs-lisp/bindat-tests.el
index a9a8819..72883fc 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -24,13 +24,15 @@
(require 'cl-lib)
(defvar header-bindat-spec
- '((dest-ip ip)
+ (bindat-spec
+ (dest-ip ip)
(src-ip ip)
(dest-port u16)
(src-port u16)))
(defvar data-bindat-spec
- '((type u8)
+ (bindat-spec
+ (type u8)
(opcode u8)
(length u16r) ;; little endian order
(id strz 8)
@@ -38,7 +40,8 @@
(align 4)))
(defvar packet-bindat-spec
- '((header struct header-bindat-spec)
+ (bindat-spec
+ (header struct header-bindat-spec)
(items u8)
(fill 3)
(item repeat (items)
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 4a01623..9312fb4 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -269,9 +269,7 @@ Edebug symbols (Bug#42672)."
(when (memq name instrumented-names)
(error "Duplicate definition of `%s'" name))
(push name instrumented-names)
- (edebug-new-definition name)))
- ;; Make generated symbols reproducible.
- (gensym-counter 10000))
+ (edebug-new-definition name))))
(eval-buffer)
(should (equal
(reverse instrumented-names)
@@ -280,11 +278,11 @@ Edebug symbols (Bug#42672)."
;; FIXME: We'd rather have names such as
;; `cl-defgeneric/edebug/method/1 ((_ number))', but
;; that requires further changes to Edebug.
- (list (intern "cl-generic-:method@10000 ((_ number))")
- (intern "cl-generic-:method@10001 ((_ string))")
- (intern "cl-generic-:method@10002 :around ((_ number))")
+ (list (intern "cl-defgeneric/edebug/method/1 (number)")
+ (intern "cl-defgeneric/edebug/method/1 (string)")
+ (intern "cl-defgeneric/edebug/method/1 :around (number)")
'cl-defgeneric/edebug/method/1
- (intern "cl-generic-:method@10003 ((_ number))")
+ (intern "cl-defgeneric/edebug/method/2 (number)")
'cl-defgeneric/edebug/method/2))))))
(provide 'cl-generic-tests)
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index f8ca39c..9257f16 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -62,12 +62,12 @@
(defun edebug-test-code-format-vector-node (node)
!start!(concat "["
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"]"))
(defun edebug-test-code-format-list-node (node)
!start!(concat "{"
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"}"))
(defun edebug-test-code-format-node (node)
@@ -137,5 +137,21 @@
,(cons func args))))
(wrap + 1 x)))
+(defun edebug-test-code-cl-flet1 ()
+ (cl-flet
+ ;; This `&rest' sexp head should not collide with
+ ;; the Edebug spec elem of the same name.
+ ((f (&rest x) x)
+ (gate (x) (+ x 5)))
+ ;; This call to `gate' shouldn't collide with the Edebug spec elem
+ ;; of the same name.
+ (message "Hi %s" (gate 7))))
+
+(defun edebug-test-code-use-gv-expander (x)
+ (declare (gv-expander
+ (lambda (do)
+ (funcall do `(car ,x) (lambda (v) `(setcar ,x ,v))))))
+ (car x))
+
(provide 'edebug-test-code)
;;; edebug-test-code.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index 6a6080d..daac433 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -951,8 +951,41 @@ primary ones (Bug#42671)."
(should
(equal
defined-symbols
- (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
- (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+ (list (intern "edebug-cl-defmethod-qualifier :around (number)")
+ (intern "edebug-cl-defmethod-qualifier (number)")))))))
+
+(ert-deftest edebug-tests--conflicting-internal-names ()
+ "Check conflicts between form's head symbols and Edebug spec elements."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "cl-flet1" '(10) t)))
+
+(ert-deftest edebug-tests-gv-expander ()
+ "Edebug can instrument `gv-expander' expressions."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "use-gv-expander" nil t)
+ (should (equal
+ (catch 'text
+ (run-at-time 0 nil
+ (lambda () (throw 'text (buffer-substring (point)
(+ (point) 5)))))
+ (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3)
t))
+ "(func"))))
+
+(defun edebug-tests--read (form spec)
+ (with-temp-buffer
+ (print form (current-buffer))
+ (goto-char (point-min))
+ (cl-letf ((edebug-all-forms t)
+ ((get (car form) 'edebug-form-spec) spec))
+ (edebug--read nil (current-buffer)))))
+
+(ert-deftest edebug-tests--&rest-behavior ()
+ ;; `&rest' is documented to allow the last "repetition" to be aborted early.
+ (should (edebug-tests--read '(dummy x 1 y 2 z)
+ '(&rest symbolp integerp)))
+ ;; `&rest' should notice here that the "symbolp integerp" sequence
+ ;; is not respected.
+ (should-error (edebug-tests--read '(dummy x 1 2 y)
+ '(&rest symbolp integerp))))
(ert-deftest edebug-tests-cl-flet ()
"Check that Edebug can instrument `cl-flet' forms without name
@@ -976,23 +1009,19 @@ clashes (Bug#41853)."
;; Make generated symbols reproducible.
(gensym-counter 10000))
(eval-buffer)
- (should (equal (reverse instrumented-names)
+ ;; Use `format' so as to throw away differences due to
+ ;; interned/uninterned symbols.
+ (should (equal (format "%s" (reverse instrumented-names))
;; The outer definitions come after the inner
;; ones because their body ends later.
- ;; FIXME: There are twice as many inner
- ;; definitions as expected due to Bug#41988.
- ;; Once that bug is fixed, remove the duplicates.
;; FIXME: We'd rather have names such as
;; `edebug-tests-cl-flet-1@inner@cl-flet@10000',
;; but that requires further changes to Edebug.
- '(inner@cl-flet@10000
- inner@cl-flet@10001
- inner@cl-flet@10002
- inner@cl-flet@10003
- edebug-tests-cl-flet-1
- inner@cl-flet@10004
- inner@cl-flet@10005
- edebug-tests-cl-flet-2))))))
+ (format "%s" '(inner@cl-flet@10000
+ inner@cl-flet@10001
+ edebug-tests-cl-flet-1
+ inner@cl-flet@10002
+ edebug-tests-cl-flet-2)))))))
(ert-deftest edebug-tests-duplicate-symbol-backtrack ()
"Check that Edebug doesn't create duplicate symbols when
diff --git a/test/lisp/emacs-lisp/macroexp-tests.el
b/test/lisp/emacs-lisp/macroexp-tests.el
new file mode 100644
index 0000000..1124e3b
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-tests.el
@@ -0,0 +1,36 @@
+;;; macroexp-tests.el --- Tests for macroexp.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2021 Stefan Monnier
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(ert-deftest macroexp--tests-fgrep ()
+ (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u))))
+ '((x))))
+ (should (equal (macroexp--fgrep '((x) (y)) '#2=([y] ((y #2#))))
+ '((y))))
+ (should (equal (macroexp--fgrep '((x) (y)) '#2=([r] ((a x)) a b c d . #2#))
+ '((x)))))
+
+(provide 'macroexp-tests)
+;;; macroexp-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f488392..9a83fa6 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2182,6 +2182,16 @@ is greater than 10.
(expand-file-name ".." "./"))
(concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
+(ert-deftest tramp-test05-expand-file-name-top ()
+ "Check `expand-file-name'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+
+ (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/")))
+ (dolist (local '("." ".."))
+ (should (string-equal (expand-file-name local dir) dir))
+ (should (string-equal (expand-file-name (concat dir local)) dir)))))
+
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
@@ -6730,8 +6740,8 @@ Since it unloads Tramp, it shall be the last test to run."
If INTERACTIVE is non-nil, the tests are run interactively."
(interactive "p")
(funcall
- (if interactive
- #'ert-run-tests-interactively #'ert-run-tests-batch) "^tramp"))
+ (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
+ "^tramp"))
;; TODO:
diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl
b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
new file mode 100644
index 0000000..c05fd7e
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
@@ -0,0 +1,158 @@
+use 5.024;
+use strict;
+use warnings;
+
+sub outside {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'";
+}
+
+package Package;
+
+=head1 NAME
+
+grammar - A Test resource for regular expressions
+
+=head1 SYNOPSIS
+
+A Perl file showing a variety of declarations
+
+=head1 DESCRIPTION
+
+This file offers several syntactical constructs for packages,
+subroutines, and POD to test the imenu capabilities of CPerl mode.
+
+Perl offers syntactical variations for package and subroutine
+declarations. Packages may, or may not, have a version and may, or
+may not, have a block of code attached to them. Subroutines can have
+old-style prototypes, attributes, and signatures which are still
+experimental but widely accepted.
+
+Various Extensions and future Perl versions will probably add new
+keywords for "class" and "method", both with syntactical extras of
+their own.
+
+This test file tries to keep up with them.
+
+=head2 Details
+
+The code is supposed to identify and exclude false positives,
+e.g. declarations in a string or in POD, as well as POD in a string.
+These should not go into the imenu index.
+
+=cut
+
+our $VERSION = 3.1415;
+say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+sub in_package {
+ # Special test for POD: A line which looks like POD, but actually
+ # is part of a multiline string. In the case shown here, the
+ # semicolon is not part of the string, but POD headings go to the
+ # end of the line. The code needs to distinguish between a POD
+ # heading "This Is Not A Pod/;" and a multiline string.
+ my $not_a_pod = q/Another false positive:
+
+=head1 This Is Not A Pod/;
+
+}
+
+sub Shoved::elsewhere {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', sub
Shoved::elsewhere";
+}
+
+sub prototyped ($$) {
+ ...;
+}
+
+package Versioned::Package 0.07;
+say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+sub versioned {
+ # This sub is in package Versioned::Package
+ say "sub 'versioned' in package '", __PACKAGE__, "'";
+}
+
+versioned();
+
+my $false_positives = <<'EOH';
+The following declarations are not supposed to be recorded for imenu.
+They are in a HERE-doc, which is a generic comment in CPerl mode.
+
+package Don::T::Report::This;
+sub this_is_no_sub {
+ my $self = shuffle;
+}
+
+And this is not a POD heading:
+
+=head1 Not a POD heading, just a string.
+
+EOH
+
+package Block {
+ our $VERSION = 2.7182;
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ sub attr:lvalue {
+ say "sub 'attr' in package '", __PACKAGE__, "'";
+ }
+
+ attr();
+
+ package Block::Inner {
+ # This hopefully doesn't happen too often.
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+ }
+
+ # Now check that we're back to package "Block"
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+sub outer {
+ # This is in package Versioned::Package
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+outer();
+
+package Versioned::Block 42 {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ my sub lexical {
+ say "sub 'lexical' in package '", __PACKAGE__, "'";
+ }
+
+ lexical();
+
+ use experimental 'signatures';
+ sub signatured :prototype($@) ($self,@rest)
+ {
+ ...;
+ }
+}
+
+# After all is said and done, we're back in package Versioned::Package.
+say "We're in package '", __PACKAGE__, "' now.";
+say "Now try to call a subroutine which went out of scope:";
+eval { lexical() };
+say $@ if $@;
+
+# Now back to Package. This must not appear separately in the
+# hierarchy list.
+package Package;
+
+our sub in_package_again {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+
+package :: {
+ # This is just a weird, but legal, package name.
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ in_package_again(); # weird, but calls the sub from above
+}
+
+Shoved::elsewhere();
+
+1;
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 943c454..61e4ece 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -166,6 +166,101 @@ point in the distant past, and is still broken in
perl-mode. "
(if (match-beginning 3) 0
perl-indent-level)))))))
+;;; Grammar based tests: unit tests
+
+(defun cperl-test--validate-regexp (regexp valid &optional invalid)
+ "Runs tests for elements of VALID and INVALID lists against REGEXP.
+Tests with elements from VALID must match, tests with elements
+from INVALID must not match. The match string must be equal to
+the whole string."
+ (funcall cperl-test-mode)
+ (dolist (string valid)
+ (should (string-match regexp string))
+ (should (string= (match-string 0 string) string)))
+ (when invalid
+ (dolist (string invalid)
+ (should-not
+ (and (string-match regexp string)
+ (string= (match-string 0 string) string))))))
+
+(ert-deftest cperl-test-ws-regexp ()
+ "Tests capture of very simple regular expressions (yawn)."
+ (let ((valid
+ '(" " "\t" "\n"))
+ (invalid
+ '("a" " " "")))
+ (cperl-test--validate-regexp cperl--ws-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-ws-or-comment-regexp ()
+ "Tests sequences of whitespace and comment lines."
+ (let ((valid
+ `(" " "\t#\n" "\n# \n"
+ ,(concat "# comment\n" "# comment\n" "\n" "#comment\n")))
+ (invalid
+ '("=head1 NAME\n" )))
+ (cperl-test--validate-regexp cperl--ws-or-comment-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-version-regexp ()
+ "Tests the regexp for recommended syntax of versions in Perl."
+ (let ((valid
+ '("1" "1.1" "1.1_1" "5.032001"
+ "v120.100.103"))
+ (invalid
+ '("alpha" "0." ".123" "1E2"
+ "v1.1" ; a "v" version string needs at least 3 components
+ ;; bad examples from "Version numbers should be boring"
+ ;; by xdg AKA David A. Golden
+ "1.20alpha" "2.34beta2" "2.00R3")))
+ (cperl-test--validate-regexp cperl--version-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-package-regexp ()
+ "Tests the regular expression of Perl package names with versions.
+Also includes valid cases with whitespace in strange places."
+ (let ((valid
+ '("package Foo"
+ "package Foo::Bar"
+ "package Foo::Bar v1.2.3"
+ "package Foo::Bar::Baz 1.1"
+ "package \nFoo::Bar\n 1.00"))
+ (invalid
+ '("package Foo;" ; semicolon must not be included
+ "package Foo 1.1 {" ; nor the opening brace
+ "packageFoo" ; not a package declaration
+ "package Foo1.1" ; invalid package name
+ "class O3D::Sphere"))) ; class not yet supported
+ (cperl-test--validate-regexp cperl--package-regexp
+ valid invalid)))
+
+;;; Function test: Building an index for imenu
+
+(ert-deftest cperl-test-imenu-index ()
+ "Test index creation for imenu.
+This test relies on the specific layout of the index alist as
+created by CPerl mode, so skip it for Perl mode."
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (with-temp-buffer
+ (insert-file (ert-resource-file "grammar.pl"))
+ (cperl-mode)
+ (let ((index (cperl-imenu--create-perl-index))
+ current-list)
+ (setq current-list (assoc-string "+Unsorted List+..." index))
+ (should current-list)
+ (let ((expected '("(main)::outside"
+ "Package::in_package"
+ "Shoved::elsewhere"
+ "Package::prototyped"
+ "Versioned::Package::versioned"
+ "Block::attr"
+ "Versioned::Package::outer"
+ "lexical"
+ "Versioned::Block::signatured"
+ "Package::in_package_again")))
+ (dolist (sub expected)
+ (should (assoc-string sub index)))))))
+
;;; Tests for issues reported in the Bug Tracker
(defun cperl-test--run-bug-10483 ()
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index badcad6..f47d54e 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -398,18 +398,21 @@ to (xref-elisp-test-descr-to-target xref)."
"(cl-defstruct (xref-elisp-location")
))
+(require 'em-xtra)
+(require 'find-dired)
(xref-elisp-deftest find-defs-defalias-defun-el
- (elisp--xref-find-definitions 'Buffer-menu-sort)
+ (elisp--xref-find-definitions 'eshell/ff)
(list
- (xref-make "(defalias Buffer-menu-sort)"
+ (xref-make "(defalias eshell/ff)"
(xref-make-elisp-location
- 'Buffer-menu-sort 'defalias
- (expand-file-name "../../../lisp/buff-menu.elc" emacs-test-dir)))
- (xref-make "(defun tabulated-list-sort)"
+ 'eshell/ff 'defalias
+ (expand-file-name "../../../lisp/eshell/em-xtra.elc"
+ emacs-test-dir)))
+ (xref-make "(defun find-name-dired)"
(xref-make-elisp-location
- 'tabulated-list-sort nil
- (expand-file-name "../../../lisp/emacs-lisp/tabulated-list.el"
emacs-test-dir)))
- ))
+ 'find-name-dired nil
+ (expand-file-name "../../../lisp/find-dired.el"
+ emacs-test-dir)))))
;; FIXME: defconst
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 4be11b8..908945f 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -51,6 +51,34 @@
(should (equal (json-parse-buffer) lisp))
(should (eobp)))))
+(ert-deftest json-serialize/roundtrip-scalars ()
+ "Check that Bug#42994 is fixed."
+ (skip-unless (fboundp 'json-serialize))
+ (dolist (case '((:null "null")
+ (:false "false")
+ (t "true")
+ (0 "0")
+ (123 "123")
+ (-456 "-456")
+ (3.75 "3.75")
+ ;; The noncharacter U+FFFF should be passed through,
+ ;; cf.
https://www.unicode.org/faq/private_use.html#noncharacters.
+ ("abc\uFFFFαβγ𝔸𝐁𝖢\"\\"
+ "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
+ (cl-destructuring-bind (lisp json) case
+ (ert-info ((format "%S ↔ %S" lisp json))
+ (should (equal (json-serialize lisp) json))
+ (with-temp-buffer
+ (json-insert lisp)
+ (should (equal (buffer-string) json))
+ (should (eobp)))
+ (should (equal (json-parse-string json) lisp))
+ (with-temp-buffer
+ (insert json)
+ (goto-char 1)
+ (should (equal (json-parse-buffer) lisp))
+ (should (eobp)))))))
+
(ert-deftest json-serialize/object ()
(skip-unless (fboundp 'json-serialize))
(let ((table (make-hash-table :test #'equal)))