[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk be2e473: Merge branch 'master' of git.sv.gnu.org:/srv/git/e
|
From: |
Yuuki Harano |
|
Subject: |
feature/pgtk be2e473: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk |
|
Date: |
Sat, 20 Feb 2021 04:17:53 -0500 (EST) |
branch: feature/pgtk
commit be2e47362b0f933dbc8e300e3d168296b7e2aac4
Merge: 949d3e5 c85c8e7
Author: Yuuki Harano <masm+github@masm11.me>
Commit: Yuuki Harano <masm+github@masm11.me>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
---
CONTRIBUTE | 14 +-
admin/CPP-DEFINES | 45 --
admin/check-doc-strings | 57 +-
admin/cus-test.el | 5 +-
admin/gitmerge.el | 2 +
configure.ac | 21 +-
doc/emacs/basic.texi | 16 +
doc/emacs/buffers.texi | 32 +-
doc/emacs/custom.texi | 9 +-
doc/emacs/display.texi | 18 +-
doc/emacs/files.texi | 2 +-
doc/emacs/indent.texi | 4 +-
doc/emacs/killing.texi | 14 +-
doc/emacs/m-x.texi | 12 +-
doc/emacs/windows.texi | 8 +-
doc/lispref/commands.texi | 97 ++-
doc/lispref/display.texi | 2 +-
doc/lispref/edebug.texi | 92 +--
doc/lispref/frames.texi | 2 +
doc/lispref/functions.texi | 10 +
doc/lispref/hash.texi | 9 +-
doc/lispref/keymaps.texi | 6 -
doc/lispref/lists.texi | 15 +-
doc/lispref/loading.texi | 5 +-
doc/lispref/maps.texi | 3 -
doc/lispref/markers.texi | 4 +-
doc/lispref/minibuf.texi | 2 +-
doc/lispref/modes.texi | 22 +
doc/lispref/processes.texi | 35 +-
doc/lispref/sequences.texi | 2 +-
doc/lispref/syntax.texi | 9 +-
doc/lispref/text.texi | 7 +-
doc/lispref/windows.texi | 2 +-
doc/misc/efaq.texi | 5 +
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 | 185 ++++-
etc/ORG-NEWS | 2 +-
etc/facemenu-removal.txt | 20 +
etc/themes/modus-operandi-theme.el | 10 +-
etc/themes/modus-vivendi-theme.el | 10 +-
lisp/auth-source.el | 77 +--
lisp/avoid.el | 21 +-
lisp/battery.el | 4 +-
lisp/bindings.el | 29 +-
lisp/bookmark.el | 80 ++-
lisp/buff-menu.el | 56 +-
lisp/calc/calc-embed.el | 30 +-
lisp/calc/calc-sel.el | 4 +-
lisp/calc/calcalg2.el | 4 +-
lisp/calculator.el | 62 +-
lisp/calendar/icalendar.el | 26 +-
lisp/calendar/parse-time.el | 2 +-
lisp/cedet/data-debug.el | 48 +-
lisp/cedet/ede.el | 2 +-
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 | 6 +-
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/project-am.el | 111 ++-
lisp/cedet/ede/srecode.el | 3 +-
lisp/cedet/ede/system.el | 2 +-
lisp/cedet/pulse.el | 4 +-
lisp/cedet/semantic/bovine/gcc.el | 14 +-
lisp/cedet/semantic/ctxt.el | 24 +-
lisp/cedet/semantic/decorate/include.el | 8 +-
lisp/cedet/semantic/decorate/mode.el | 6 +-
lisp/cedet/semantic/idle.el | 32 +-
lisp/cedet/semantic/lex-spp.el | 55 +-
lisp/cedet/semantic/lex.el | 44 +-
lisp/cedet/semantic/scope.el | 14 +-
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/comint.el | 7 +-
lisp/cus-dep.el | 4 +-
lisp/cus-edit.el | 7 +-
lisp/cus-start.el | 2 +-
lisp/dired-x.el | 2 +-
lisp/emacs-lisp/autoload.el | 15 +-
lisp/emacs-lisp/backtrace.el | 8 +-
lisp/emacs-lisp/bindat.el | 332 +++++----
lisp/emacs-lisp/byte-opt.el | 491 +++++++++-----
lisp/emacs-lisp/byte-run.el | 19 +-
lisp/emacs-lisp/bytecomp.el | 51 +-
lisp/emacs-lisp/chart.el | 6 +-
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 | 750 +++++++++------------
lisp/emacs-lisp/eieio-compat.el | 2 +-
lisp/emacs-lisp/eldoc.el | 7 +-
lisp/emacs-lisp/ert.el | 4 +-
lisp/emacs-lisp/generator.el | 21 +-
lisp/emacs-lisp/gv.el | 12 +-
lisp/emacs-lisp/lisp-mnt.el | 2 +-
lisp/emacs-lisp/lisp-mode.el | 3 -
lisp/emacs-lisp/macroexp.el | 121 +++-
lisp/emacs-lisp/package.el | 53 +-
lisp/emacs-lisp/pcase.el | 91 ++-
lisp/emacs-lisp/pp.el | 5 +-
lisp/emacs-lisp/rx.el | 2 +-
lisp/emacs-lisp/seq.el | 1 +
lisp/emacs-lisp/tcover-ses.el | 2 +
lisp/emacs-lisp/testcover.el | 52 +-
lisp/epa.el | 6 +-
lisp/epg.el | 24 +-
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-imenu.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 | 4 +-
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/em-cmpl.el | 6 +-
lisp/eshell/esh-var.el | 2 +-
lisp/face-remap.el | 6 +-
lisp/facemenu.el | 4 -
lisp/files.el | 19 +-
lisp/frame.el | 1 +
lisp/generic-x.el | 337 ++++-----
lisp/gnus/deuglify.el | 10 +-
lisp/gnus/gnus-art.el | 283 ++++----
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-search.el | 41 +-
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 | 117 ++--
lisp/gnus/gnus-util.el | 5 +
lisp/gnus/gnus-uu.el | 99 +--
lisp/gnus/gnus-vm.el | 4 +-
lisp/gnus/gnus.el | 53 +-
lisp/gnus/message.el | 142 ++--
lisp/gnus/mml-sec.el | 57 +-
lisp/gnus/mml.el | 2 +-
lisp/gnus/nnagent.el | 1 +
lisp/gnus/nnselect.el | 2 +-
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/help-mode.el | 28 +-
lisp/image-mode.el | 10 +-
lisp/image/exif.el | 5 +-
lisp/imenu.el | 70 +-
lisp/indent.el | 5 +-
lisp/info.el | 79 ++-
lisp/international/characters.el | 2 +-
lisp/international/mule-cmds.el | 67 +-
lisp/isearch.el | 6 +-
lisp/jsonrpc.el | 8 +-
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 | 27 +-
lisp/mail/mail-utils.el | 4 +-
lisp/man.el | 32 +-
lisp/menu-bar.el | 6 +-
lisp/mh-e/mh-show.el | 2 +-
lisp/minibuffer.el | 11 +-
lisp/net/dictionary-connection.el | 27 +-
lisp/net/dictionary.el | 195 +++---
lisp/net/eudcb-macos-contacts.el | 2 +-
lisp/net/eww.el | 78 ++-
lisp/net/ldap.el | 10 +-
lisp/net/mailcap.el | 12 +-
lisp/net/mairix.el | 145 ++--
lisp/net/newst-treeview.el | 30 +-
lisp/net/shr.el | 1 +
lisp/net/snmp-mode.el | 44 +-
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 | 5 +-
lisp/net/tramp-sudoedit.el | 3 +
lisp/net/tramp.el | 10 +-
lisp/net/trampver.el | 5 +
lisp/nxml/nxml-mode.el | 2 +-
lisp/org/ob-comint.el | 6 +-
lisp/org/ob-core.el | 17 +-
lisp/org/ob-tangle.el | 3 +-
lisp/org/ol-w3m.el | 6 +-
lisp/org/org-agenda.el | 2 +-
lisp/org/org-clock.el | 6 +-
lisp/org/org-pcomplete.el | 11 +-
lisp/org/org-refile.el | 6 +-
lisp/pcmpl-gnu.el | 8 +-
lisp/pcmpl-linux.el | 6 +-
lisp/pcmpl-unix.el | 2 +-
lisp/pcmpl-x.el | 3 +-
lisp/pcomplete.el | 15 +-
lisp/play/5x5.el | 73 +-
lisp/play/blackbox.el | 18 +-
lisp/play/cookie1.el | 14 +-
lisp/play/decipher.el | 84 +--
lisp/play/doctor.el | 2 +-
lisp/play/gametree.el | 2 +-
lisp/play/gomoku.el | 109 ++-
lisp/play/hanoi.el | 2 +-
lisp/play/snake.el | 15 +-
lisp/play/tetris.el | 19 +-
lisp/play/zone.el | 21 +-
lisp/plstore.el | 3 +-
lisp/progmodes/antlr-mode.el | 5 +-
lisp/progmodes/bug-reference.el | 3 +-
lisp/progmodes/cc-engine.el | 2 +-
lisp/progmodes/cfengine.el | 4 -
lisp/progmodes/cmacexp.el | 12 +-
lisp/progmodes/compile.el | 4 +
lisp/progmodes/cperl-mode.el | 642 +++++++++---------
lisp/progmodes/cpp.el | 43 +-
lisp/progmodes/cwarn.el | 9 +-
lisp/progmodes/dcl-mode.el | 75 +--
lisp/progmodes/elisp-mode.el | 33 +-
lisp/progmodes/executable.el | 29 +-
lisp/progmodes/flymake.el | 4 +-
lisp/progmodes/grep.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 | 51 +-
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/tcl.el | 29 +-
lisp/progmodes/verilog-mode.el | 4 +-
lisp/progmodes/xscheme.el | 16 +-
lisp/ps-samp.el | 2 +-
lisp/registry.el | 33 +-
lisp/repeat.el | 71 ++
lisp/replace.el | 1 +
lisp/shell.el | 5 +-
lisp/simple.el | 289 +++++---
lisp/skeleton.el | 8 +-
lisp/speedbar.el | 9 +-
lisp/subr.el | 174 +++--
lisp/tab-bar.el | 109 +--
lisp/textmodes/bib-mode.el | 11 +-
lisp/textmodes/bibtex.el | 2 +-
lisp/textmodes/dns-mode.el | 20 +-
lisp/textmodes/enriched.el | 16 +-
lisp/textmodes/ispell.el | 94 +--
lisp/textmodes/makeinfo.el | 6 +-
lisp/textmodes/nroff-mode.el | 2 +-
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/texinfmt.el | 10 +-
lisp/textmodes/texinfo.el | 25 +-
lisp/textmodes/texnfo-upd.el | 2 +-
lisp/textmodes/text-mode.el | 4 -
lisp/textmodes/tildify.el | 9 -
lisp/textmodes/two-column.el | 18 +-
lisp/thumbs.el | 35 +-
lisp/url/url-http.el | 2 +-
lisp/vc/ediff-init.el | 42 +-
lisp/vc/ediff-util.el | 4 +-
lisp/vc/pcvs-parse.el | 15 +-
lisp/vc/smerge-mode.el | 12 +-
lisp/vc/vc-bzr.el | 24 +-
lisp/vc/vc-cvs.el | 18 +-
lisp/vc/vc-dir.el | 62 +-
lisp/vc/vc-git.el | 38 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-svn.el | 4 +-
lisp/w32-fns.el | 1 +
lisp/wid-browse.el | 23 +-
lisp/window.el | 35 +
lisp/woman.el | 18 +-
src/buffer.c | 14 +
src/buffer.h | 3 +
src/callint.c | 9 +-
src/callproc.c | 6 +-
src/data.c | 87 ++-
src/dispnew.c | 2 +-
src/emacs-module.c | 8 +-
src/eval.c | 41 +-
src/filelock.c | 2 +-
src/fns.c | 33 +
src/font.c | 2 +-
src/frame.c | 20 +-
src/frame.h | 10 +-
src/image.c | 13 +-
src/indent.c | 2 +-
src/json.c | 77 +--
src/lisp.h | 4 +
src/lread.c | 3 +-
src/minibuf.c | 115 +++-
src/nsfns.m | 25 +-
src/nsterm.h | 1 +
src/nsterm.m | 63 ++
src/pdumper.c | 3 +-
src/process.c | 2 +-
src/w32.c | 51 ++
src/w32fns.c | 32 +-
src/window.h | 4 -
src/xdisp.c | 16 +-
src/xfaces.c | 2 +-
src/xfns.c | 43 +-
test/Makefile.in | 13 +-
test/README | 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/cedet/cedet-files-tests.el | 54 ++
test/lisp/cedet/inversion-tests.el | 81 +++
test/lisp/cedet/semantic-utest-fmt.el | 127 ----
.../cedet/semantic-utest-ia-resources}/test.mk | 0
.../cedet/semantic-utest-ia-resources}/test.srt | 0
.../cedet/semantic-utest-ia-resources}/test.texi | 0
.../semantic-utest-ia-resources}/testdoublens.cpp | 0
.../semantic-utest-ia-resources}/testdoublens.hpp | 0
.../semantic-utest-ia-resources}/testfriends.cpp | 1 -
.../semantic-utest-ia-resources}/testjavacomp.java | 0
.../semantic-utest-ia-resources}/testlocalvars.cpp | 0
.../cedet/semantic-utest-ia-resources}/testnsp.cpp | 0
.../semantic-utest-ia-resources}/testsppcomplete.c | 0
.../semantic-utest-ia-resources}/teststruct.cpp | 0
.../semantic-utest-ia-resources}/testsubclass.cpp | 0
.../semantic-utest-ia-resources}/testsubclass.hh | 0
.../semantic-utest-ia-resources}/testtemplates.cpp | 0
.../semantic-utest-ia-resources}/testtypedefs.cpp | 0
.../semantic-utest-ia-resources}/testusing.cpp | 0
.../semantic-utest-ia-resources}/testusing.hh | 0
.../semantic-utest-ia-resources}/testvarnames.c | 0
.../semantic-utest-ia-resources}/testvarnames.java | 0
.../semantic-utest-ia-resources}/testwisent.wy | 0
test/lisp/cedet/semantic-utest-ia.el | 71 +-
test/lisp/cedet/semantic/bovine/gcc-tests.el | 129 ++++
.../cedet/semantic/format-resources}/test-fmt.cpp | 0
.../cedet/semantic/format-resources}/test-fmt.el | 2 +-
test/lisp/cedet/semantic/format-tests.el | 95 +++
test/lisp/cedet/semantic/fw-tests.el | 45 ++
test/lisp/cedet/srecode/document-tests.el | 80 +++
.../cedet/srecode/fields-tests.el} | 94 +--
test/lisp/cus-edit-tests.el | 4 +-
test/lisp/dom-tests.el | 2 +
test/lisp/emacs-lisp/bindat-tests.el | 9 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 92 ++-
test/lisp/emacs-lisp/cl-extra-tests.el | 22 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 12 +-
test/lisp/emacs-lisp/cl-lib-tests.el | 22 +-
test/lisp/emacs-lisp/cl-macs-tests.el | 22 +-
.../edebug-resources/edebug-test-code.el | 42 +-
test/lisp/emacs-lisp/edebug-tests.el | 113 ++--
test/lisp/emacs-lisp/ert-tests.el | 22 +-
test/lisp/emacs-lisp/ert-x-tests.el | 22 +-
test/lisp/emacs-lisp/lisp-mode-tests.el | 2 +
test/lisp/emacs-lisp/lisp-tests.el | 2 +
test/lisp/emacs-lisp/macroexp-tests.el | 36 +
test/lisp/emacs-lisp/rx-tests.el | 2 +
.../emacs-lisp/testcover-resources/testcases.el | 22 +-
test/lisp/emacs-lisp/testcover-tests.el | 22 +-
test/lisp/gnus/gnus-search-tests.el | 8 +-
test/lisp/gnus/gnus-util-tests.el | 8 +-
test/lisp/gnus/mm-decode-tests.el | 6 +-
test/lisp/gnus/mml-sec-tests.el | 9 +-
test/lisp/jsonrpc-tests.el | 2 +-
test/lisp/mail/mail-utils-tests.el | 104 +++
test/lisp/net/ntlm-resources/authinfo | 1 +
test/lisp/net/ntlm-tests.el | 368 ++++++++++
test/lisp/net/sasl-scram-rfc-tests.el | 2 +
test/lisp/net/tramp-tests.el | 18 +-
test/lisp/nxml/nxml-mode-tests.el | 2 +
test/lisp/nxml/xsd-regexp-tests.el | 2 +
test/lisp/obsolete/cl-tests.el | 22 +-
test/lisp/play/cookie1-resources/cookies | 8 +
test/lisp/play/cookie1-tests.el | 40 ++
.../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/lisp/progmodes/tcl-tests.el | 1 -
test/lisp/simple-tests.el | 25 +
test/lisp/textmodes/dns-mode-tests.el | 21 +
test/manual/cedet/cedet-utests.el | 105 +--
test/manual/cedet/ede-tests.el | 14 +-
test/manual/cedet/semantic-tests.el | 122 ----
test/manual/cedet/tests/test.el | 2 +-
test/manual/etags/ETAGS.good_1 | 10 +-
test/manual/etags/el-src/TAGTEST.EL | 2 +
test/src/fns-tests.el | 30 +-
test/src/indent-tests.el | 22 +-
test/src/json-tests.el | 28 +
test/src/keyboard-tests.el | 39 +-
test/src/process-tests.el | 28 +
461 files changed, 8319 insertions(+), 6228 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index cb09391..bbf5262 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -66,11 +66,15 @@ more reliably, and makes the job of applying the patches
easier and less
error-prone. It also allows sending patches whose author is someone
other than the email sender.
-Once the cumulative amount of your submissions exceeds about 15 lines
-of non-trivial changes, we will need you to assign to the FSF the
-copyright for your contributions. Ask on emacs-devel@gnu.org, and we
-will send you the necessary form together with the instructions to
-fill and email it, in order to start this legal paperwork.
+Once the cumulative amount of your submissions exceeds a dozen or so
+lines of non-trivial changes, we will need you to assign to the FSF
+the copyright for your contributions. (To see how many lines were
+non-trivially changed, count only added and modified lines in the
+patched code. Consider an added or changed line non-trivial if it
+includes at least one identifier, string, or substantial comment.)
+Ask on emacs-devel@gnu.org, and we will send you the necessary form
+together with the instructions to fill and email it, in order to start
+this legal paperwork.
** Issue tracker (a.k.a. "bug tracker")
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/admin/gitmerge.el b/admin/gitmerge.el
index b92ecc7..851212c 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -7,6 +7,8 @@
;; Keywords: maint
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/configure.ac b/configure.ac
index 7b691cf..86af53b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -409,19 +409,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.])
;;
@@ -460,7 +459,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])
@@ -1769,8 +1768,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)
@@ -2264,7 +2263,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
@@ -4792,10 +4791,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..4a34fd3 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the
command
@code{goto-line-relative} to move point to the line relative to the
accessible portion of the narrowed buffer.
+@code{goto-line} has its own history list (@pxref{Minibuffer
+History}). You can have either a single list shared between all
+buffers (the default) or a separate list for each buffer, by
+customizing the user option @code{goto-line-history-local}.
+
@item M-g @key{TAB}
@kindex M-g TAB
@findex move-to-column
@@ -880,3 +885,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/buffers.texi b/doc/emacs/buffers.texi
index 9cdfa49..3a166e4 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -232,9 +232,9 @@ unless they visit files: such buffers are used internally
by Emacs.
@table @kbd
@item C-x C-q
Toggle read-only status of buffer (@code{read-only-mode}).
-@item M-x rename-buffer @key{RET} @var{buffer} @key{RET}
+@item C-x x r @key{RET} @var{buffer} @key{RET}
Change the name of the current buffer.
-@item M-x rename-uniquely
+@item C-x x u
Rename the current buffer by adding @samp{<@var{number}>} to the end.
@item M-x view-buffer @key{RET} @var{buffer} @key{RET}
Scroll through buffer @var{buffer}. @xref{View Mode}.
@@ -263,28 +263,28 @@ non-@code{nil} value, making the buffer read-only with
@kbd{C-x C-q}
also enables View mode in the buffer (@pxref{View Mode}).
@findex rename-buffer
- @kbd{M-x rename-buffer} changes the name of the current buffer. You
-specify the new name as a minibuffer argument; there is no default.
-If you specify a name that is in use for some other buffer, an error
-happens and no renaming is done.
+ @kbd{C-x x r} (@code{rename-buffer} changes the name of the current
+buffer. You specify the new name as a minibuffer argument; there is
+no default. If you specify a name that is in use for some other
+buffer, an error happens and no renaming is done.
@findex rename-uniquely
- @kbd{M-x rename-uniquely} renames the current buffer to a similar
-name with a numeric suffix added to make it both different and unique.
-This command does not need an argument. It is useful for creating
-multiple shell buffers: if you rename the @file{*shell*} buffer, then
-do @kbd{M-x shell} again, it makes a new shell buffer named
-@file{*shell*}; meanwhile, the old shell buffer continues to exist
-under its new name. This method is also good for mail buffers,
+ @kbd{C-x x u} (@code{rename-uniquely}) renames the current buffer to
+a similar name with a numeric suffix added to make it both different
+and unique. This command does not need an argument. It is useful for
+creating multiple shell buffers: if you rename the @file{*shell*}
+buffer, then do @kbd{M-x shell} again, it makes a new shell buffer
+named @file{*shell*}; meanwhile, the old shell buffer continues to
+exist under its new name. This method is also good for mail buffers,
compilation buffers, and most Emacs features that create special
buffers with particular names. (With some of these features, such as
@kbd{M-x compile}, @kbd{M-x grep}, you need to switch to some other
buffer before using the command again, otherwise it will reuse the
current buffer despite the name change.)
- The commands @kbd{M-x append-to-buffer} and @kbd{M-x insert-buffer}
-can also be used to copy text from one buffer to another.
-@xref{Accumulating Text}.
+ The commands @kbd{M-x append-to-buffer} and @kbd{C-x x i}
+(@code{insert-buffer}) can also be used to copy text from one buffer
+to another. @xref{Accumulating Text}.
@node Kill Buffer
@section Killing Buffers
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ccf5f19..22900c5 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -519,12 +519,9 @@ Set up a customization buffer for all the settings and
groups that
match @var{regexp}.
@item M-x customize-changed @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the settings and groups
-whose meaning has changed since Emacs version @var{version}.
-
-@item M-x customize-changed-options @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the options whose meaning or
-default values have changed since Emacs version @var{version}.
+Set up a customization buffer with all the user options, faces and
+groups whose meaning has changed since (or been added after) Emacs
+version @var{version}.
@item M-x customize-saved
Set up a customization buffer containing all settings that you
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index f4b1854..58d08b4 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -173,6 +173,10 @@ line; on subsequent consecutive invocations, make the
current line the
top line, the bottom line, and so on in cyclic order. Possibly
redisplay the screen too (@code{recenter-top-bottom}).
+@item C-M-S-l
+Scroll the other window; this is equivalent to @kbd{C-l} acting on the
+other window.
+
@item M-x recenter
Scroll the selected window so the current line is the center-most text
line. Possibly redisplay the screen too.
@@ -1755,13 +1759,13 @@ and/or leftmost columns.
@findex toggle-truncate-lines
Horizontal scrolling automatically causes line truncation
(@pxref{Horizontal Scrolling}). You can explicitly enable line
-truncation for a particular buffer with the command @kbd{M-x
-toggle-truncate-lines}. This works by locally changing the variable
-@code{truncate-lines}. If that variable is non-@code{nil}, long lines
-are truncated; if it is @code{nil}, they are continued onto multiple
-screen lines. Setting the variable @code{truncate-lines} in any way
-makes it local to the current buffer; until that time, the default
-value, which is normally @code{nil}, is in effect.
+truncation for a particular buffer with the command @kbd{C-x x t}
+(@code{toggle-truncate-lines}). This works by locally changing the
+variable @code{truncate-lines}. If that variable is non-@code{nil},
+long lines are truncated; if it is @code{nil}, they are continued onto
+multiple screen lines. Setting the variable @code{truncate-lines} in
+any way makes it local to the current buffer; until that time, the
+default value, which is normally @code{nil}, is in effect.
If a split window becomes too narrow, Emacs may automatically enable
line truncation. @xref{Split Window}, for the variable
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 12ceac8..6b3bc43 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -927,7 +927,7 @@ Manual}). For customizations, see the Custom group
@code{time-stamp}.
If you have made extensive changes to a file-visiting buffer and
then change your mind, you can @dfn{revert} the changes and go back to
-the saved version of the file. To do this, type @kbd{C-x g}. Since
+the saved version of the file. To do this, type @kbd{C-x x g}. Since
reverting unintentionally could lose a lot of work, Emacs asks for
confirmation first.
diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi
index df9e67f..d989f34 100644
--- a/doc/emacs/indent.texi
+++ b/doc/emacs/indent.texi
@@ -136,8 +136,8 @@ this transient mode is active, typing @kbd{@key{LEFT}} or
@kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one
space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to
indent leftward or rightward to the next tab stop (@pxref{Tab Stops}).
-Typing any other key disables the transient mode, and resumes normal
-editing.
+Typing any other key disables the transient mode, and this key is then
+acted upon as normally.
If called with a prefix argument @var{n}, this command indents the
lines forward by @var{n} spaces (without enabling the transient mode).
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 9bc786d..8434040 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -703,13 +703,13 @@ copy-to-buffer} is similar, except that any existing text
in the other
buffer is deleted, so the buffer is left containing just the text newly
copied into it.
- The command @kbd{M-x insert-buffer} can be used to retrieve the
-accumulated text from another buffer. This prompts for the name of a
-buffer, and inserts a copy of all the text in that buffer into the
-current buffer at point, leaving point at the beginning of the
-inserted text. It also adds the position of the end of the inserted
-text to the mark ring, without activating the mark. @xref{Buffers},
-for background information on buffers.
+ The command @kbd{C-x x i} (@code{insert-buffer}) can be used to
+retrieve the accumulated text from another buffer. This prompts for
+the name of a buffer, and inserts a copy of all the text in that
+buffer into the current buffer at point, leaving point at the
+beginning of the inserted text. It also adds the position of the end
+of the inserted text to the mark ring, without activating the mark.
+@xref{Buffers}, for background information on buffers.
Instead of accumulating text in a buffer, you can append text
directly into a file with @kbd{M-x append-to-file}. This prompts for
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/emacs/windows.texi b/doc/emacs/windows.texi
index e851f1b..c66deb7 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -161,6 +161,8 @@ Select another window (@code{other-window}).
Scroll the next window upward (@code{scroll-other-window}).
@item C-M-S-v
Scroll the next window downward (@code{scroll-other-window-down}).
+@item C-M-S-l
+Recenter the next window (@code{recenter-other-window}).
@item mouse-1
@kbd{mouse-1}, in the text area of a window, selects the window and
moves point to the position clicked. Clicking in the mode line
@@ -194,6 +196,8 @@ rebind a command.)
@findex scroll-other-window
@kindex C-M-S-v
@findex scroll-other-window-down
+@kindex C-M-S-l
+@findex recenter-other-window
The usual scrolling commands (@pxref{Display}) apply to the selected
window only, but there are also commands to scroll the next window.
@kbd{C-M-v} (@code{scroll-other-window}) scrolls the window that
@@ -203,7 +207,9 @@ take positive and negative arguments. (In the minibuffer,
@kbd{C-M-v}
scrolls the help window associated with the minibuffer, if any, rather
than the next window in the standard cyclic order; @pxref{Minibuffer
Edit}.) @kbd{C-M-S-v} (@code{scroll-other-window-down}) scrolls the
-next window downward in a similar way.
+next window downward in a similar way. Likewise, @kbd{C-M-S-l}
+(@code{recenter-other-window}) behaves like @kbd{C-l}
+(@code{recenter-top-bottom}) in the next window.
@vindex mouse-autoselect-window
If you set @code{mouse-autoselect-window} to a non-@code{nil} value,
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 3a2c7d0..1c762c2 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
@@ -488,7 +493,10 @@ I/O.
Point and the mark, as two numeric arguments, smallest first. This is
the only code letter that specifies two successive arguments rather than
one. This will signal an error if the mark is not set in the buffer
-which is current when the command is invoked. No I/O.
+which is current when the command is invoked. If Transient Mark mode
+is turned on (@pxref{The Mark}) --- as it is by default --- and user
+option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal
+an error even if the mark @emph{is} set, but is inactive. No I/O.
@item s
Arbitrary text, read in the minibuffer and returned as a string
@@ -588,6 +596,77 @@ 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 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 if used outside of a Dired
+buffer.
+
+Emacs therefore has a mechanism for specifying what mode (or modes) a
+command ``belongs'' 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
+don't support the extended @code{interactive} form), the following
+equivalent declaration (@pxref{Declare Form}) 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 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 they can be issued by the user from pretty much any
+context.
+
@node Generic Commands
@subsection Select among Command Alternatives
@cindex generic commands
@@ -756,6 +835,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/display.texi b/doc/lispref/display.texi
index 93e935c..131ad2d 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1997,7 +1997,7 @@ the beginning of the result if a multi-column character in
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
-more charcaters will be removed from @var{string} to free enough space
+more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{width} columns. However, if
the display width of @var{string} is less than the display width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If
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/frames.texi b/doc/lispref/frames.texi
index a15511d..f4316b7 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1802,6 +1802,8 @@ Geometry}).
@item child-frame-border-width
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}) if the given frame is a child frame (@pxref{Child Frames}).
+If this is @code{nil}, the value specified by the
+@code{internal-border-width} parameter is used instead.
@vindex vertical-scroll-bars@r{, a frame parameter}
@item vertical-scroll-bars
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/hash.texi b/doc/lispref/hash.texi
index 8781fad..12c6a65 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -150,11 +150,11 @@ multiplied by an approximation to this value. The
default for
@end table
@end defun
-You can also create a new hash table using the printed representation
+You can also create a hash table using the printed representation
for hash tables. The Lisp reader can read this printed
representation, provided each element in the specified hash table has
a valid read syntax (@pxref{Printed Representation}). For instance,
-the following specifies a new hash table containing the keys
+the following specifies a hash table containing the keys
@code{key1} and @code{key2} (both symbols) associated with @code{val1}
(a symbol) and @code{300} (a number) respectively.
@@ -162,6 +162,11 @@ the following specifies a new hash table containing the
keys
#s(hash-table size 30 data (key1 val1 key2 300))
@end example
+Note, however, that when using this in Emacs Lisp code, it's
+undefined whether this creates a new hash table or not. If you want
+to create a new hash table, you should always use
+@code{make-hash-table} (@pxref{Self-Evaluating Forms}).
+
@noindent
The printed representation for a hash table consists of @samp{#s}
followed by a list beginning with @samp{hash-table}. The rest of the
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 55d179b..6a227e3 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -574,12 +574,6 @@ key.
key.
@item
-@cindex @kbd{M-o}
-@vindex facemenu-keymap
-@code{facemenu-keymap} is the global keymap used for the @kbd{M-o}
-prefix key.
-
-@item
The other Emacs prefix keys are @kbd{C-x @@}, @kbd{C-x a i}, @kbd{C-x
@key{ESC}} and @kbd{@key{ESC} @key{ESC}}. They use keymaps that have
no special names.
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index c54496f..2805b1f 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1168,13 +1168,14 @@ x
@end group
@end example
-However, the other arguments (all but the last) should be mutable lists.
-
-A common pitfall is to use a constant list as a non-last
-argument to @code{nconc}. If you do this, the resulting behavior
-is undefined. It is possible that your program will change
-each time you run it! Here is what might happen (though this
-is not guaranteed to happen):
+However, the other arguments (all but the last) should be mutable
+lists.
+
+A common pitfall is to use a constant list as a non-last argument to
+@code{nconc}. If you do this, the resulting behavior is undefined
+(@pxref{Self-Evaluating Forms}). It is possible that your program
+will change each time you run it! Here is what might happen (though
+this is not guaranteed to happen):
@smallexample
@group
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/maps.texi b/doc/lispref/maps.texi
index aea0242..59c6e6f 100644
--- a/doc/lispref/maps.texi
+++ b/doc/lispref/maps.texi
@@ -53,9 +53,6 @@ A sparse keymap for subcommands of the prefix @kbd{C-x r}.@*
@item esc-map
A full keymap for @key{ESC} (or @key{Meta}) commands.
-@item facemenu-keymap
-A sparse keymap used for the @kbd{M-o} prefix key.
-
@item function-key-map
The parent keymap of all @code{local-function-key-map} (q.v.@:) instances.
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index b39373f..80f79b6 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -609,8 +609,8 @@ the function @code{use-region-p} for that (@pxref{The
Region}).
@defvarx deactivate-mark-hook
These normal hooks are run, respectively, when the mark becomes active
and when it becomes inactive. The hook @code{activate-mark-hook} is
-also run at the end of the command loop if the mark is active and it
-is possible that the region may have changed.
+also run when the region is reactivated, for instance after using a
+command that switches back to a buffer that has an active mark.
@ignore
This piece of command_loop_1, run unless deactivating the mark:
if (current_buffer != prev_buffer || MODIFF != prev_modiff)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 185d355..b60775d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2393,7 +2393,7 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
keys in minibuffer local keymaps. The command throws an error if the
-current buffer is not the active minibuffer.
+current buffer is a minibuffer, but not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit
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/sequences.texi b/doc/lispref/sequences.texi
index 0c74dbe..545fd40 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -609,7 +609,7 @@ returned value is a list.
(seq-map-indexed (lambda (elt idx)
(list idx elt))
'(a b c))
-@result{} ((0 a) (b 1) (c 2))
+@result{} ((0 a) (1 b) (2 c))
@end group
@end example
@end defun
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 4a316a1..2df6c15 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -573,10 +573,11 @@ and by Font Lock mode during syntactic fontification
(@pxref{Syntactic
Font Lock}). It is called with two arguments, @var{start} and
@var{end}, which are the starting and ending positions of the text on
which it should act. It is allowed to call @code{syntax-ppss} on any
-position before @var{end}, but if it calls @code{syntax-ppss} on some
-position and later modifies the buffer on some earlier position,
-then it is its responsibility to call @code{syntax-ppss-flush-cache}
-to flush the now obsolete info from the cache.
+position before @var{end}, but if a Lisp program calls
+@code{syntax-ppss} on some position and later modifies the buffer at
+some earlier position, then it is that program's responsibility to
+call @code{syntax-ppss-flush-cache} to flush the now obsolete info
+from the cache.
@strong{Caution:} When this variable is non-@code{nil}, Emacs removes
@code{syntax-table} text properties arbitrarily and relies on
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/lispref/windows.texi b/doc/lispref/windows.texi
index f305d1a..c32d711 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2557,7 +2557,7 @@ frame visible and, unless @var{alist} contains an
This function tries to display @var{buffer} by finding a window
that is displaying a buffer in a given mode.
-If @var{alist} contains a @code{mode} entry, its value specifes a
+If @var{alist} contains a @code{mode} entry, its value specifies a
major mode (a symbol) or a list of major modes. If @var{alist}
contains no @code{mode} entry, the current major mode of @var{buffer}
is used instead. A window is a candidate if it displays a buffer
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index f26ae63..6f0a81b 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -388,6 +388,11 @@ posting a followup that recommends such software.
@uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid
posting bug reports to this newsgroup directly (@pxref{Reporting bugs}).
+Finally, we recommend reading the
+@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind
+Communications Guidelines} before posting to any GNU lists or
+newsgroups.
+
@node Newsgroup archives
@section Where can I get old postings to @uref{news:gnu.emacs.help} and other
GNU groups?
@cindex Archived postings from @code{gnu.emacs.help}
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 fb77688..ee8a68a 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
@@ -87,6 +90,10 @@ useful on systems such as FreeBSD which ships only with
"etc/termcap".
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
++++
+** New command 'recenter-other-window', bound to 'S-M-C-l'.
+Like 'recenter-top-bottom' acting in the other window.
+
** Minibuffer scrolling is now conservative by default.
This is controlled by the new variable 'scroll-minibuffer-conservatively'.
@@ -234,11 +241,25 @@ still applies for shorter search strings, which avoids
flicker in the
search buffer due to too many matches being highlighted.
+++
-** 'revert-buffer' is now bound to 'C-x g' globally.
+** A new keymap for buffer actions has been added.
+The 'C-x x' keymap now holds keystrokes for various buffer-oriented
+commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
+'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
+('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t'
+('toggle-truncate-lines').
* 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
@@ -324,6 +345,11 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
++++
+** The history list for the 'goto-line' command is now a single list
+for all buffers by default. You can configure a separate list for
+each buffer by customizing the user option 'goto-line-history-local'.
+
** Outline
+++
@@ -340,6 +366,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
+++
@@ -446,6 +477,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'.
---
@@ -465,9 +499,14 @@ applied when the option 'tab-line-tab-face-functions' is
so-configured. That option may also be used to customize tab-line
faces in other ways.
-** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
+** Occur mode
+
+*** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
'previous-error-no-select' bound to 'p'.
+*** The new command 'recenter-current-error', bound to 'l' in Occur or
+compilation buffers, recenters the current displayed occurrence/error.
+
** EIEIO
+++
@@ -588,6 +627,13 @@ This is used when expanding commit messages from
'vc-print-root-log'
and similar commands.
---
+*** New faces for 'vc-dir' buffers.
+Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
+'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
+'vc-dir-status-edited', 'vc-dir-status-up-to-date',
+'vc-dir-status-ignored'.
+
+---
*** The responsible VC backend is now the most specific one.
'vc-responsible-backend' loops over the backends in
'vc-handled-backends' to determine which backend is responsible for a
@@ -852,6 +898,14 @@ so e.g. like 'C-x 8 [' inserts a left single quotation
mark,
'C-x \ [' does the same.
---
+*** New user options 'read-char-by-name-sort' and 'read-char-by-name-group'.
+'read-char-by-name-sort' defines the sorting order of characters for
+completion of 'C-x 8 RET TAB' and can be customized to sort them
+by codepoints instead of character names by default. The 't' value of
+'read-char-by-name-group' groups the characters for completion of
+'C-x 8 RET TAB' by Unicode blocks.
+
+---
*** Improved language transliteration in Malayalam input methods.
Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
deprecated. Errors in the Inscript method were corrected.
@@ -896,21 +950,42 @@ To revert to the previous behavior,
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
-'customize-changed-options'.
+'customize-changed'.
To customize obsolete user options, use 'customize-option' or
'customize-saved'.
** Edebug
+---
+*** Obsoletions
+**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
+
++++
+**** 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:
+
+++
-*** Edebug specification lists can use the new keyword '&error', which
-unconditionally aborts the current edebug instrumentation with the
-supplied error message.
+**** '&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
@@ -940,7 +1015,7 @@ separate buffer, or a tooltip.
*** New user option 'eldoc-documentation-strategy'.
The built-in choices available for this user option let users compose
the results of 'eldoc-documentation-functions' in various ways, even
-if some of those functions are sychronous and some asynchchronous.
+if some of those functions are synchronous and some asynchronous.
The user option replaces 'eldoc-documentation-function', which is now
obsolete.
@@ -1600,6 +1675,13 @@ that makes it a valid button.
*** New variable 'thing-at-point-provider-alist'.
This allows mode-specific alterations to how 'thing-at-point' works.
+** Enriched mode
+
+---
+*** 'C-a' is by default no longer bound to 'beginning-of-line-text'.
+This is so 'C-a' works as in other modes, and in particular holding
+Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
+
** Miscellaneous
+++
@@ -1982,6 +2064,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
@@ -2012,6 +2114,14 @@ first).
* Incompatible Editing Changes in Emacs 28.1
+** 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,
@@ -2029,6 +2139,8 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
+** 'pcomplete-ignore-case' is now an obsolete alias of
'completion-ignore-case'.
+
** 'completions-annotations' face is not used when the caller puts own face.
This affects the suffix specified by completion 'annotation-function'.
@@ -2085,6 +2197,11 @@ parameter.
by mistake and were not useful to Lisp code.
---
+** Loading 'generic-x' unconditionally loads all modes.
+The user option `generic-extras-enable-list' is now obsolete, and
+setting it has no effect.
+
+---
** The 'load-dangerous-libraries' variable is now obsolete.
It was used to allow loading Lisp libraries compiled by XEmacs, a
modified version of Emacs which is no longer actively maintained.
@@ -2188,6 +2305,48 @@ 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.
+
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
@@ -2482,6 +2641,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/etc/ORG-NEWS b/etc/ORG-NEWS
index 2cae8b9..2b9cbf3 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -747,7 +747,7 @@ removed.
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
-code above to clean things up anyways!
+code above to clean things up anyway!
**** New hooks
Two hooks are added to org-attach:
diff --git a/etc/facemenu-removal.txt b/etc/facemenu-removal.txt
new file mode 100644
index 0000000..9a969df
--- /dev/null
+++ b/etc/facemenu-removal.txt
@@ -0,0 +1,20 @@
+`facemenu-keymap' (normally bound to `M-o') has been disabled.
+==============================================================
+
+We've disabled the normal `M-o' keymap for a month (until March the
+10th, 2021) in the development version of Emacs to see whether anybody
+uses this feature.
+
+If the removal of this key binding doesn't annoy too many people, the
+plan is to then leave the it unbound, for usage by third-party
+packages and users.
+
+If you wish to restore the binding during the trial period, you can
+put the following in your .emacs file:
+
+(facemenu-keymap-restore)
+
+After the trial period is over, the function will be removed.
+
+If you wish to protest the removal of the `M-o' key binding, please
+send your thoughts to the emacs-devel@gnu.org mailing list.
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index c7a0f72..346000a 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -10,18 +10,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index 6e71e8d..73f07d6 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -10,18 +10,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 2494040..14cae8a 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -581,14 +581,15 @@ default value. If the user, host, or port are missing,
the alist
`auth-source-creation-prompts' will be used to look up the
prompts IN THAT ORDER (so the `user' prompt will be queried first,
then `host', then `port', and finally `secret'). Each prompt string
-can use %u, %h, and %p to show the user, host, and port.
+can use %u, %h, and %p to show the user, host, and port. The prompt
+is formatted with `format-prompt', a trailing \": \" is removed.
Here's an example:
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
- \\='((secret . \"Enter IMAP password for %h:%p: \"))))
+ \\='((secret . \"Enter IMAP password for %h:%p\"))))
(auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc
:max 1
:P \"pppp\" :Q \"qqqq\"
:create \\='(A B Q)))
@@ -860,7 +861,9 @@ while \(:host t) would find all host entries."
secret)))
(defun auth-source-format-prompt (prompt alist)
- "Format PROMPT using %x (for any character x) specifiers in ALIST."
+ "Format PROMPT using %x (for any character x) specifiers in ALIST.
+Remove trailing \": \"."
+ (setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt))
(dolist (cell alist)
(let ((c (nth 0 cell))
(v (nth 1 cell)))
@@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC."
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC."
(setq check nil)))
ret))
(t 'never)))
- (plain (or (eval default) (read-passwd
prompt))))
+ (plain
+ (or (eval default)
+ (read-passwd (format-prompt prompt
nil)))))
;; ask if we don't know what to do (in which case
;; auth-source-netrc-use-gpg-tokens must be a
list)
(unless gpg-encrypt
@@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC."
(if (eq gpg-encrypt 'gpg)
(auth-source-epa-make-gpg-token plain file)
plain))
- (if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0
(match-beginning 0))
- " (default " default "):
")
- (concat prompt "(default " default
") "))
- nil nil default)
+ (if (and (stringp default) auth-source-save-behavior)
+ (read-string
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@@ -1745,12 +1747,12 @@ authentication tokens:
"[any label]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: ")
- (label "Enter label for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h")
+ (label "Enter label for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -1760,13 +1762,11 @@ authentication tokens:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
- (or (eval default) (read-passwd prompt))
- (if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0
(match-beginning 0))
- " (default " default "):
")
- (concat prompt "(default " default
") "))
- nil nil default)
+ (or (eval default)
+ (read-passwd (format-prompt prompt nil)))
+ (if (and (stringp default) auth-source-save-behavior)
+ (read-string
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
@@ -2190,11 +2190,11 @@ entries for git.gnus.org:
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
- (secret "%p password for %u@%h: ")
- (user "%p user name for %h: ")
- (host "%p host name for user %u: ")
- (port "%p port for %u@%h: "))
- (format "Enter %s (%%u@%%h:%%p): " r)))
+ (secret "%p password for %u@%h")
+ (user "%p user name for %h")
+ (host "%p host name for user %u")
+ (port "%p port for %u@%h"))
+ (format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
@@ -2204,14 +2204,11 @@ entries for git.gnus.org:
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
- (or (eval default) (read-passwd prompt))
- (if (stringp default)
+ (or (eval default)
+ (read-passwd (format-prompt prompt nil)))
+ (if (and (stringp default) auth-source-save-behavior)
(read-string
- (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0 (match-beginning
0))
- " (default " default "): ")
- (concat prompt "(default " default ") "))
- nil nil default)
+ (format-prompt prompt default) nil nil default)
(eval default)))))
(when data
diff --git a/lisp/avoid.el b/lisp/avoid.el
index b53584b..3b3848e 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -25,8 +25,10 @@
;; For those who are annoyed by the mouse pointer obscuring text,
;; this mode moves the mouse pointer - either just a little out of
;; the way, or all the way to the corner of the frame.
-;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
-;; To set up permanently, put the following in your .emacs:
+;;
+;; To use, type `M-x mouse-avoidance-mode'.
+;;
+;; To set up permanently, put this in your .emacs:
;;
;; (if (display-mouse-p) (mouse-avoidance-mode 'animate))
;;
@@ -47,11 +49,6 @@
;;
;; For completely random pointer shape, replace the setq above with:
;; (setq x-pointer-shape (mouse-avoidance-random-shape))
-;;
-;; Bugs / Warnings / To-Do:
-;;
-;; - Using this code does slow Emacs down. "banish" mode shouldn't
-;; be too bad, and on my workstation even "animate" is reasonable.
;; Credits:
;; This code was helped by all those who contributed suggestions,
@@ -76,7 +73,7 @@
"Activate Mouse Avoidance mode.
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `mouse-avoidance-mode'."
+use either \\[customize] or \\[mouse-avoidance-mode]."
:set (lambda (_symbol value)
;; 'none below prevents toggling when value is nil.
(mouse-avoidance-mode (or value 'none)))
@@ -261,9 +258,9 @@ If you want the mouse banished to a different corner set
(t 0))))
(defun mouse-avoidance-nudge-mouse ()
- ;; Push the mouse a little way away, possibly animating the move.
- ;; For these modes, state keeps track of the total offset that we've
- ;; accumulated, and tries to keep it close to zero.
+ "Push the mouse a little way away, possibly animating the move.
+For these modes, state keeps track of the total offset that we've
+accumulated, and tries to keep it close to zero."
(let* ((cur (mouse-position))
(cur-pos (cdr cur))
(pos (window-edges))
@@ -375,7 +372,7 @@ redefine this function to suit your own tastes."
(setq mouse-avoidance-state nil))))))
(defun mouse-avoidance-fancy ()
- ;; Used for the "fancy" modes, ie jump et al.
+ ;; Used for the "fancy" modes, i.e. jump et al.
(if (and (not mouse-avoidance-animating-pointer)
(not (mouse-avoidance-ignore-p))
(mouse-avoidance-too-close-p (mouse-position)))
diff --git a/lisp/battery.el b/lisp/battery.el
index 77ad73d..59f6987 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -246,7 +246,7 @@ seconds."
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(and (eq battery-status-function #'battery-upower)
battery-upower-subscribe
- (battery--upower-subsribe))
+ (battery--upower-subscribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler))
(battery-update))
@@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler."
(mapc #'dbus-unregister-object battery--upower-signals)
(setq battery--upower-signals ()))
-(defun battery--upower-subsribe ()
+(defun battery--upower-subscribe ()
"Subscribe to UPower device change signals."
(push (dbus-register-signal :system battery-upower-service
battery-upower-path
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 9ea188d..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)
@@ -1413,7 +1430,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "z" 'repeat)
-(define-key ctl-x-map "g" #'revert-buffer)
+(defvar ctl-x-x-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "g" #'revert-buffer)
+ (define-key map "r" #'rename-buffer)
+ (define-key map "u" #'rename-uniquely)
+ (define-key map "n" #'clone-buffer)
+ (define-key map "i" #'insert-buffer)
+ (define-key map "t" #'toggle-truncate-lines)
+ map)
+ "Keymap for subcommands of C-x x.")
+(define-key ctl-x-map "x" ctl-x-x-map)
(define-key esc-map "\C-l" 'reposition-window)
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-embed.el b/lisp/calc/calc-embed.el
index cfb3fda..7455140 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -854,31 +854,21 @@ The command \\[yank] can retrieve it from there."
(newmode (cl-assoc-if #'derived-mode-p
calc-embedded-open-close-mode-alist)))
(when newann
- (make-local-variable 'calc-embedded-announce-formula)
- (setq calc-embedded-announce-formula (cdr newann)))
+ (setq-local calc-embedded-announce-formula (cdr newann)))
(when newform
- (make-local-variable 'calc-embedded-open-formula)
- (make-local-variable 'calc-embedded-close-formula)
- (setq calc-embedded-open-formula (nth 0 (cdr newform)))
- (setq calc-embedded-close-formula (nth 1 (cdr newform))))
+ (setq-local calc-embedded-open-formula (nth 0 (cdr newform)))
+ (setq-local calc-embedded-close-formula (nth 1 (cdr newform))))
(when newword
- (make-local-variable 'calc-embedded-word-regexp)
- (setq calc-embedded-word-regexp (nth 1 newword)))
+ (setq-local calc-embedded-word-regexp (nth 1 newword)))
(when newplain
- (make-local-variable 'calc-embedded-open-plain)
- (make-local-variable 'calc-embedded-close-plain)
- (setq calc-embedded-open-plain (nth 0 (cdr newplain)))
- (setq calc-embedded-close-plain (nth 1 (cdr newplain))))
+ (setq-local calc-embedded-open-plain (nth 0 (cdr newplain)))
+ (setq-local calc-embedded-close-plain (nth 1 (cdr newplain))))
(when newnewform
- (make-local-variable 'calc-embedded-open-new-formula)
- (make-local-variable 'calc-embedded-close-new-formula)
- (setq calc-embedded-open-new-formula (nth 0 (cdr newnewform)))
- (setq calc-embedded-close-new-formula (nth 1 (cdr newnewform))))
+ (setq-local calc-embedded-open-new-formula (nth 0 (cdr
newnewform)))
+ (setq-local calc-embedded-close-new-formula (nth 1 (cdr
newnewform))))
(when newmode
- (make-local-variable 'calc-embedded-open-mode)
- (make-local-variable 'calc-embedded-close-mode)
- (setq calc-embedded-open-mode (nth 0 (cdr newmode)))
- (setq calc-embedded-close-mode (nth 1 (cdr newmode)))))))
+ (setq-local calc-embedded-open-mode (nth 0 (cdr newmode)))
+ (setq-local calc-embedded-close-mode (nth 1 (cdr newmode)))))))
(while (and (cdr found)
(> point (aref (car (cdr found)) 3)))
(setq found (cdr found)))
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/calc/calcalg2.el b/lisp/calc/calcalg2.el
index fc6eb74..94b99aa 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -1545,9 +1545,7 @@
(set-buffer trace-buffer)
(goto-char (point-max))
(or (assq 'scroll-stop (buffer-local-variables))
- (progn
- (make-local-variable 'scroll-step)
- (setq scroll-step 3)))
+ (setq-local scroll-step 3))
(insert "\n\n\n")
(set-buffer calcbuf)
(math-try-integral sexpr))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index b4c0075..0088398 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -20,23 +20,18 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;=====================================================================
;;; Commentary:
-;;
+
;; A calculator for Emacs.
;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
;; whatever), when you have Emacs running already?
;;
-;; If this is not part of your Emacs distribution, then simply bind
-;; `calculator' to a key and make it an autoloaded function, e.g.:
-;; (autoload 'calculator "calculator"
-;; "Run the Emacs calculator." t)
+;; You can bind this to a key by adding this to your Init file:
+;;
;; (global-set-key [(control return)] 'calculator)
;;
;; Written by Eli Barzilay, eli@barzilay.org
-;;
-;;;=====================================================================
;;; Customization:
(defgroup calculator nil
@@ -50,19 +45,16 @@
"Run `calculator' electrically, in the echo area.
Electric mode saves some place but changes the way you interact with the
calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-use-menu t
"Make `calculator' create a menu.
Note that this requires easymenu. Must be set before loading."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-bind-escape nil
"If non-nil, set escape to exit the calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-unary-style 'postfix
"Value is either `prefix' or `postfix'.
@@ -75,44 +67,38 @@ This determines the default behavior of unary operators."
It should contain a \"%s\" somewhere that will indicate the i/o radixes;
this will be a two-character string as described in the documentation
for `calculator-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-number-digits 3
"The calculator's number of digits used for standard display.
Used by the `calculator-standard-display' function - it will use the
format string \"%.NC\" where this number is N and C is a character given
at runtime."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-mode t
"Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix')."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-radix-grouping-digits 4
"The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-separator "'"
"The separator used in radix grouping display.
See `calculator-radix-grouping-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-remove-zeros t
"Non-nil value means delete all redundant zero decimal digits.
If this value is not t and not nil, redundant zeros are removed except
for one.
Used by the `calculator-remove-zeros' function."
- :type '(choice (const t) (const leave-decimal) (const nil))
- :group 'calculator)
+ :type '(choice (const t) (const leave-decimal) (const nil)))
(defcustom calculator-displayer '(std ?n)
"A displayer specification for numerical values.
@@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the
arguments."
:type '(choice (function) (string) (sexp)
(list (const std) character)
- (list (const std) character boolean))
- :group 'calculator)
+ (list (const std) character boolean)))
(defcustom calculator-displayers
'(((std ?n) "Standard display, decimal point or scientific")
@@ -152,15 +137,13 @@ specification is the same as the values that can be
stored in
`calculator-displayer'.
`calculator-rotate-displayer' rotates this list."
- :type 'sexp
- :group 'calculator)
+ :type 'sexp)
(defcustom calculator-paste-decimals t
"If non-nil, convert pasted integers so they have a decimal point.
This makes it possible to paste big integers since they will be read as
floats, otherwise the Emacs reader will fail on them."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(make-obsolete-variable 'calculator-paste-decimals
"it is no longer used." "26.1")
@@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them."
`calculator-displayer', to format a string before copying it with
`calculator-copy'. If nil, then `calculator-displayer's normal value is
used."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-2s-complement nil
"If non-nil, show negative numbers in 2s complement in radix modes.
Otherwise show as a negative number."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-mode-hook nil
"List of hook functions for `calculator-mode' to run.
@@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook
will get
activated in the minibuffer -- in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
- :type 'hook
- :group 'calculator)
+ :type 'hook)
(defcustom calculator-user-registers nil
"An association list of user-defined register bindings.
@@ -200,8 +180,7 @@ before you load calculator."
(when (boundp 'calculator-registers)
(setq calculator-registers
(append val calculator-registers)))
- (setq calculator-user-registers val))
- :group 'calculator)
+ (setq calculator-user-registers val)))
(defcustom calculator-user-operators nil
"A list of additional operators.
@@ -234,8 +213,7 @@ Examples:
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
- :type '(repeat (list string symbol sexp integer integer))
- :group 'calculator)
+ :type '(repeat (list string symbol sexp integer integer)))
;;;=====================================================================
;;; Code:
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/calendar/parse-time.el b/lisp/calendar/parse-time.el
index ba7418f..aa3236c 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -29,7 +29,7 @@
;; `parse-time-string' parses a time in a string and returns a list of
;; values, just like `decode-time', where unspecified elements in the
-;; string are returned as nil (except unspecfied DST is returned as -1).
+;; string are returned as nil (except unspecified DST is returned as -1).
;; `encode-time' may be applied on these values to obtain an internal
;; time value.
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index a062a5a..f0fa91b 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1045,30 +1045,30 @@ If the result is a list or vector, then use the data
debugger to display it."
(list (let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Eval: "
nil read-expression-map t
- 'read-expression-history))
- ))
-
- (if (null eval-expression-debug-on-error)
- (setq values (cons (eval expr) values))
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (setq values (cons (eval expr) values))
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (if (or (consp (car values)) (vectorp (car values)))
- (let ((v (car values)))
- (data-debug-show-stuff v "Expression"))
- ;; Old style
- (prog1
- (prin1 (car values) t)
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str t))))))
+ 'read-expression-history))))
+
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result (values--store-value (eval expr)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result (values--store-value (eval expr)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (if (or (consp result) (vectorp result))
+ (let ((v result))
+ (data-debug-show-stuff v "Expression"))
+ ;; Old style
+ (prog1
+ (prin1 result t)
+ (let ((str (eval-expression-print-format result)))
+ (if str (princ str t)))))))
(provide 'data-debug)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index e3cc906..369a9f7 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1518,7 +1518,7 @@ It does not apply the value to buffers."
;;; FIXME: Could someone look into implementing `project-ignores' for
;;; EDE and/or a faster `project-files'?
-(add-hook 'project-find-functions #'project-try-ede)
+(add-hook 'project-find-functions #'project-try-ede 50)
(provide 'ede)
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 2b1e50d..9da6374 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,10 +1,12 @@
-;;; 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.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
@@ -43,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/project-am.el b/lisp/cedet/ede/project-am.el
index 061d1b5..d676c57 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,4 +1,4 @@
-;;; project-am.el --- A project management scheme based on automake files.
+;;; project-am.el --- A project management scheme based on automake files.
-*- lexical-binding: t; -*-
;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
@@ -54,17 +54,14 @@
(defcustom project-am-compile-project-command nil
"Default command used to compile a project."
- :group 'project-am
:type '(choice (const nil) string))
(defcustom project-am-compile-target-command (concat ede-make-command " -k %s")
"Default command used to compile a project."
- :group 'project-am
:type 'string)
(defcustom project-am-debug-target-function 'gdb
"Default Emacs command used to debug a target."
- :group 'project-am
:type 'function) ; make this be a list some day
(defconst project-am-type-alist
@@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(cl-defmethod project-new-target ((proj project-am-makefile)
- &optional name type)
+(cl-defmethod project-new-target ((_proj project-am-makefile)
+ &optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
matching something in `project-am-type-alist' or type class symbol.
@@ -300,7 +297,7 @@ buffer being in order to provide a smart default target
type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(cl-defmethod project-compile-project ((obj project-am-target) &optional
command)
+(cl-defmethod project-compile-project ((_obj project-am-target) &optional
command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((_obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-target ((obj project-am-target) &optional
command)
+(cl-defmethod project-compile-target ((_obj project-am-target) &optional
command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the
target."
;;; Project loading and saving
;;
-(defun project-am-load (directory &optional rootproj)
+(defun project-am-load (directory &optional _rootproj)
"Read an automakefile DIRECTORY into our data structure.
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
@@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project."
(file-name-directory (directory-file-name newdir))))
(expand-file-name dir)))
+(defvar recentf-exclude)
+
(defmacro project-am-with-makefile-current (dir &rest forms)
"Set the Makefile.am in DIR to be the current buffer.
-Run FORMS while the makefile is current.
-Kill the makefile if it was not loaded before the load."
- `(let* ((fn (expand-file-name "Makefile.am" ,dir))
- (fb nil)
- (kb (get-file-buffer fn)))
- (if (not (file-exists-p fn))
- nil
- (save-excursion
- (if kb (setq fb kb)
- ;; We need to find-file this thing, but don't use
- ;; any semantic features.
- (let ((semantic-init-hook nil)
- (recentf-exclude '( (lambda (f) t) ))
- )
- (setq fb (find-file-noselect fn)))
- )
- (set-buffer fb)
- (prog1 ,@forms
- (if (not kb) (kill-buffer (current-buffer))))))))
-(put 'project-am-with-makefile-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-makefile-current
- (form def-body))))
-
+Run FORMS while the makefile is current."
+ (declare (indent 1) (debug (form def-body)))
+ `(project-am--with-makefile-current ,dir (lambda () ,@forms)))
+
+(defun project-am--with-makefile-current (dir fun)
+ (let* ((fn (expand-file-name "Makefile.am" dir))
+ (kb (get-file-buffer fn)))
+ (if (not (file-exists-p fn))
+ nil
+ (with-current-buffer
+ (or kb
+ ;; We need to find-file this thing, but don't use
+ ;; any semantic features.
+ (let ((semantic-init-hook nil)
+ (recentf-exclude `(,(lambda (_f) t))))
+ (find-file-noselect fn)))
+ (unwind-protect (funcall fun)
+ (if (not kb) (kill-buffer (current-buffer))))))))
(defun project-am-load-makefile (path &optional suggestedname)
"Convert PATH into a project Makefile, and return its project object.
@@ -480,6 +471,7 @@ This is used when subprojects are made in named
subdirectories."
(if (and ede-object (project-am-makefile-p ede-object))
ede-object
(let* ((pi (project-am-package-info path))
+ (fn buffer-file-name)
(sfn (when suggestedname
(project-am-last-dir suggestedname)))
(pn (or sfn (nth 0 pi) (project-am-last-dir fn)))
@@ -734,19 +726,19 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES"))
-(cl-defmethod project-am-macro ((this project-am-header-noinst))
+(cl-defmethod project-am-macro ((_this project-am-header-noinst))
"Return the default macro to `edit' for this object."
"noinst_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-inst))
+(cl-defmethod project-am-macro ((_this project-am-header-inst))
"Return the default macro to `edit' for this object."
"include_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-pkg))
+(cl-defmethod project-am-macro ((_this project-am-header-pkg))
"Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-chk))
+(cl-defmethod project-am-macro ((_this project-am-header-chk))
"Return the default macro to `edit' for this object."
"check_HEADERS")
@@ -758,7 +750,7 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(oref this name))
-(cl-defmethod project-am-macro ((this project-am-lisp))
+(cl-defmethod project-am-macro ((_this project-am-lisp))
"Return the default macro to `edit' for this object."
"lisp_LISP")
@@ -785,13 +777,11 @@ nil means that this buffer belongs to no-one."
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this file) efn)
- (string-match "/configure\\.ac$" efn)
- (string-match "/configure\\.in$" efn)
- (string-match "/configure$" efn)
+ (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn)
;; Search output files.
(let ((ans nil))
(dolist (f (oref this configureoutputfiles))
- (when (string-match (concat (regexp-quote f) "$") efn)
+ (when (string-match (concat (regexp-quote f) "\\'") efn)
(setq ans t)))
ans)
)))
@@ -822,7 +812,7 @@ nil means that this buffer belongs to no-one."
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(cl-defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((_this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
@@ -861,7 +851,7 @@ Argument FILE is the file to extract the end directory name
from."
(t
'project-am-program)))
-(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer)
"There are no default header files."
(or (cl-call-next-method)
(let ((s (oref this source))
@@ -910,22 +900,13 @@ files in the project."
"Set the Configure FILE in the top most directory above DIR as current.
Run FORMS in the configure file.
Kill the Configure buffer if it was not already in a buffer."
- `(save-excursion
- (let ((fb (generate-new-buffer ,file)))
- (set-buffer fb)
- (erase-buffer)
- (insert-file-contents ,file)
- (prog1 ,@forms
- (kill-buffer fb)))))
-
-(put 'project-am-with-config-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-config-current
- (form def-body))))
-
-(defmacro project-am-extract-shell-variable (var)
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (erase-buffer)
+ (insert-file-contents ,file)
+ ,@forms))
+
+(defun project-am-extract-shell-variable (var)
"Extract the value of the shell variable VAR from a shell script."
(save-excursion
(goto-char (point-min))
@@ -997,12 +978,12 @@ Calculates the info with
`project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(cl-defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((_this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(cl-defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((_this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
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/pulse.el b/lisp/cedet/pulse.el
index aef4fc8..3257feb 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
-;;; pulse.el --- Pulsing Overlays
+;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*-
-;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.0
diff --git a/lisp/cedet/semantic/bovine/gcc.el
b/lisp/cedet/semantic/bovine/gcc.el
index 1cfe5a3..c2121e5 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
+;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -25,6 +25,7 @@
;; GCC, and set up the preprocessor and include paths.
(require 'semantic/dep)
+(require 'cl-lib)
(defvar semantic-lex-c-preprocessor-symbol-file)
(defvar semantic-lex-c-preprocessor-symbol-map)
@@ -88,10 +89,9 @@ to give to the program."
(let ((path (substring line 1)))
(when (and (file-accessible-directory-p path)
(file-name-absolute-p path))
- (add-to-list 'inc-path
- (expand-file-name path)
- t))))))))
- inc-path))
+ (cl-pushnew (expand-file-name path) inc-path
+ :test #'equal))))))))
+ (nreverse inc-path)))
(defun semantic-cpp-defs (str)
@@ -101,7 +101,7 @@ to give to the program."
(dolist (L lines)
(let ((dat (split-string L)))
(when (= (length dat) 3)
- (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
+ (push (cons (nth 1 dat) (nth 2 dat)) lst))))
lst))
(defun semantic-gcc-fields (str)
@@ -142,6 +142,8 @@ This is an alist, and should include keys of:
`--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
+(defvar c++-include-path)
+
;;;###autoload
(defun semantic-gcc-setup ()
"Setup Semantic C/C++ parsing based on GCC output."
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/idle.el b/lisp/cedet/semantic/idle.el
index 9f1bcfa..5af4607 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,4 +1,4 @@
-;;; idle.el --- Schedule parsing tasks in idle time
+;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t;
-*-
;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc.
@@ -222,18 +222,18 @@ And also manages services that depend on tag values."
(and (buffer-file-name b)
b))
(buffer-list)))))
- safe ;; This safe is not used, but could be.
+ ;; safe ;; This safe is not used, but could be.
others
mode)
(when (semantic-idle-scheduler-enabled-p)
(save-excursion
;; First, reparse the current buffer.
- (setq mode major-mode
- safe (semantic-safe "Idle Parse Error: %S"
- ;(error "Goofy error 1")
- (semantic-idle-scheduler-refresh-tags)
- )
- )
+ (setq mode major-mode)
+ ;; (setq safe
+ (semantic-safe "Idle Parse Error: %S"
+ ;(error "Goofy error 1")
+ (semantic-idle-scheduler-refresh-tags))
+
;; Now loop over other buffers with same major mode, trying to
;; update them as well. Stop on keypress.
(dolist (b buffers)
@@ -430,6 +430,8 @@ datasets."
(message "Long Work Idle Timer...%s" exit-type)))
)
+(defvar ede-auto-add-method)
+
(defun semantic-idle-scheduler-work-parse-neighboring-files ()
"Parse all the files in similar directories to buffers being edited."
;; Let's tell EDE to ignore all the files we're about to load
@@ -564,11 +566,12 @@ DOC will be a documentation string describing FORMS.
FORMS will be called during idle time after the current buffer's
semantic tag information has been updated.
This routine creates the following functions and variables:"
+ (declare (indent 1) (debug (&define name stringp def-body)))
(let ((global (intern (concat "global-" (symbol-name name) "-mode")))
(mode (intern (concat (symbol-name name) "-mode")))
(hook (intern (concat (symbol-name name) "-mode-hook")))
(map (intern (concat (symbol-name name) "-mode-map")))
- (setup (intern (concat (symbol-name name) "-mode-setup")))
+ ;; (setup (intern (concat (symbol-name name) "-mode-setup")))
(func (intern (concat (symbol-name name) "-idle-function"))))
`(progn
@@ -618,11 +621,6 @@ turned on in every Semantic-supported buffer.")
,(concat "Perform idle activity for the minor mode `"
(symbol-name mode) "'.")
,@forms))))
-(put 'define-semantic-idle-service 'lisp-indent-function 1)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec define-semantic-idle-service
- (&define name stringp def-body))))
;;; SUMMARY MODE
;;
@@ -821,6 +819,8 @@ turned on in every Semantic-supported buffer."
(make-obsolete-variable 'semantic-idle-symbol-highlight-face
"customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
+(defvar pulse-flag)
+
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
TAG was found as the symbol under point. If it happens to be
@@ -898,7 +898,7 @@ Call `semantic-symref-hits-in-region' to identify local
references."
(when (semantic-tag-p target)
(require 'semantic/symref/filter)
(semantic-symref-hits-in-region
- target (lambda (start end prefix)
+ target (lambda (start end _prefix)
(when (/= start (car Hbounds))
(pulse-momentary-highlight-region
start end semantic-idle-symbol-highlight-face))
@@ -1231,7 +1231,7 @@ shortened at the beginning."
)
(defun semantic-idle-breadcrumbs--format-linear
- (tag-list &optional max-length)
+ (tag-list &optional _max-length)
"Format TAG-LIST as a linear list, starting with the outermost tag.
MAX-LENGTH is not used."
(require 'semantic/analyze/fcn)
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 4cafc7d..b3399aa 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -469,11 +469,9 @@ PROPERTY set."
;;; Lexical Analyzer framework settings
;;
-;; FIXME change to non-obsolete default.
-(defvar-local semantic-lex-analyzer 'semantic-flex
+(defvar-local semantic-lex-analyzer 'semantic-lex
"The lexical analyzer used for a given buffer.
-See `semantic-lex' for documentation.
-For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
+See `semantic-lex' for documentation.")
(defvar semantic-lex-tokens
'(
@@ -762,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.
@@ -1066,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.
@@ -1098,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)
@@ -1124,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)
@@ -1141,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)
@@ -1165,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
@@ -1686,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"))
@@ -1709,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/scope.el b/lisp/cedet/semantic/scope.el
index 31576d2..6bd04b2 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,4 +1,4 @@
-;;; semantic/scope.el --- Analyzer Scope Calculations
+;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t;
-*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.")
)
(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
- new-tags)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
@@ -262,7 +262,7 @@ are from nesting data types."
(semantic-go-to-tag pparent)
(setq stack (semantic-find-tag-by-overlay (point)))
;; Step one, find the merged version of stack in the typecache.
- (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
+ (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack)))
(tc nil)
)
;; @todo - can we use the typecache ability to
@@ -317,7 +317,7 @@ are from nesting data types."
;; returnlist is empty.
(while snlist
(setq fullsearchname
- (append (mapcar 'semantic-tag-name returnlist)
+ (append (mapcar #'semantic-tag-name returnlist)
(list (car snlist)))) ;; Next one
(setq ptag
(semanticdb-typecache-find fullsearchname))
@@ -325,8 +325,8 @@ are from nesting data types."
(when (or (not ptag)
(not (semantic-tag-of-class-p ptag 'type)))
(let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
+ (apply #'append
+ (mapcar #'semantic-tag-type-members
(cons (car returnlist) scopetypes)
)))
)
@@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE."
(setq leftover (cons S leftover)))))
(nreverse leftover)))
-(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit
protection)
+(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit
_protection)
"Return all parts of TYPE, a tag representing a TYPE declaration.
SCOPE is the scope object.
NOINHERIT turns off searching of inherited tags.
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/comint.el b/lisp/comint.el
index a9633d0..ea69c3b 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -378,7 +378,7 @@ This variable is buffer-local."
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
- "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'")
+ "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:version "27.1"
@@ -700,8 +700,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html
;;
;; This makes it really work to keep point at the bottom.
- ;; (make-local-variable 'scroll-conservatively)
- ;; (setq scroll-conservatively 10000)
+ ;; (setq-local scroll-conservatively 10000)
(add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-variable 'comint-ptyp)
(make-local-variable 'comint-process-echoes)
@@ -2433,6 +2432,8 @@ This function could be in the list
`comint-output-filter-functions'."
(replace-regexp-in-string "\r" "" string)))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
+ (when (string-match "\n+\\'" string)
+ (setq string (replace-match "" t t string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
(if (> comint--prompt-recursion-depth 10)
(message "Password prompt recursion too deep")
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index a52d082..f0b108b 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -178,7 +178,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(insert "\
;; The remainder of this file is for handling :version.
-;; We provide a minimum of information so that `customize-changed-options'
+;; We provide a minimum of information so that `customize-changed'
;; can do its job.
;; For groups we set `custom-version', `group-documentation' and
@@ -239,7 +239,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
This is an alist whose members have as car a version string, and as
elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
-buffer that `customize-changed-options' generates.\")\n\n"))
+buffer that `customize-changed' generates.\")\n\n"))
(save-buffer)
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 66808b9..745f6bc 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it."
(message "`%s' is an alias for `%s'" symbol basevar))))
(defvar customize-changed-options-previous-release "26.3"
- "Version for `customize-changed-options' to refer back to by default.")
+ "Version for `customize-changed' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###autoload
@@ -1242,10 +1242,11 @@ the user might see the value in an error message, a
good choice is
the official name of the package, such as MH-E or Gnus.")
;;;###autoload
-(defalias 'customize-changed 'customize-changed-options)
+(define-obsolete-function-alias 'customize-changed-options
+ #'customize-changed "28.1")
;;;###autoload
-(defun customize-changed-options (&optional since-version)
+(defun customize-changed (&optional since-version)
"Customize all settings whose meanings have changed in Emacs itself.
This includes new user options and faces, and new customization
groups, as well as older options and faces whose meanings or
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 27fdb72..c0a4a6d 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -343,7 +343,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(const :tag "Never" nil)
(const :tag "Always" t)
(repeat (symbol :tag "Parameter")))
- "25.1")
+ "27.1")
(iconify-child-frame frames
(choice
(const :tag "Do nothing" nil)
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52ecc..1199de1 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -447,7 +447,7 @@ If it is `no-dir', omitting is much faster, but you can
only match
against the non-directory part of the file name. Set it to nil if you
need to match the entire file name.")
-;; \017=^O for Omit - other packages can chose other control characters.
+;; \017=^O for Omit - other packages can choose other control characters.
(defvar dired-omit-marker-char ?\017
"Temporary marker used by Dired-Omit.
Should never be used as marker by the user or other packages.")
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index ec7492d..ae17039 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)))
@@ -207,7 +210,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..b1b2144 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
@@ -41,23 +41,23 @@
;; Consider the following C structures:
;;
;; struct header {
-;; unsigned long dest_ip;
-;; unsigned long src_ip;
-;; unsigned short dest_port;
-;; unsigned short src_port;
+;; uint32_t dest_ip;
+;; uint32_t src_ip;
+;; uint16_t dest_port;
+;; uint16_t src_port;
;; };
;;
;; struct data {
-;; unsigned char type;
-;; unsigned char opcode;
-;; unsigned long length; /* In little endian order */
+;; uint8_t type;
+;; uint8_t opcode;
+;; uint32_t length; /* In little endian order */
;; unsigned char id[8]; /* nul-terminated string */
;; unsigned char data[/* (length + 3) & ~3 */];
;; };
;;
;; struct packet {
;; struct header header;
-;; unsigned char items;
+;; uint8_t items;
;; unsigned char filler[3];
;; struct data item[/* items */];
;; };
@@ -65,21 +65,24 @@
;; 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
+;; (length u32r) ;; little endian order
;; (id strz 8)
;; (data vec (length))
;; (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 66a117f..e0feb95 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -289,7 +289,7 @@
(byte-compile-preprocess
(byte-compile--reify-function fn))))))
(if (eq (car-safe newfn) 'function)
- (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+ (macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form)))
;; This can happen because of macroexp-warn-and-return &co.
(byte-compile-warn
"Inlining closure %S failed" name)
@@ -297,77 +297,91 @@
(_ ;; Give up on inlining.
form))))
-
-;; ((lambda ...) ...)
-(defun byte-compile-unfold-lambda (form &optional name)
- ;; In lexical-binding mode, let and functions don't bind vars in the same way
- ;; (let obey special-variable-p, but functions don't). But luckily, this
- ;; doesn't matter here, because function's behavior is underspecified so it
- ;; can safely be turned into a `let', even though the reverse is not true.
- (or name (setq name "anonymous lambda"))
- (let* ((lambda (car form))
- (values (cdr form))
- (arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (byte-compile-warn "attempt to open-code `%s' with too few
arguments" name)
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (progn
- (or (eq values 'too-few)
- (byte-compile-warn
- "attempt to open-code `%s' with too many arguments" name))
- form)
-
- ;; The following leads to infinite
recursion when loading a
- ;; file containing `(defsubst f ()
(f))', and then trying to
- ;; byte-compile that file.
- ;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
- (if bindings
- (cons 'let (cons (nreverse bindings) body))
- (cons 'progn body))))
- (byte-compile-log " %s\t==>\t%s" form newform)
- newform))))
-
;;; implementing source-level optimizers
+(defconst byte-optimize-enable-variable-constprop t
+ "If non-nil, enable constant propagation through local variables.")
+
+(defconst byte-optimize-warn-eliminated-variable nil
+ "Whether to warn when a variable is optimised away entirely.
+This does usually not indicate a problem and makes the compiler
+very chatty, but can be useful for debugging.")
+
+(defvar byte-optimize--lexvars nil
+ "Lexical variables in scope, in reverse order of declaration.
+Each element is on the form (NAME KEEP [VALUE]), where:
+ NAME is the variable name,
+ KEEP is a boolean indicating whether the binding must be retained,
+ VALUE, if present, is a substitutable expression.
+Earlier variables shadow later ones with the same name.")
+
+(defvar byte-optimize--vars-outside-condition nil
+ "Alist of variables lexically bound outside conditionally executed code.
+Variables here are sensitive to mutation inside the conditional code,
+since their contents in sequentially later code depends on the path taken
+and may no longer be statically known.
+Same format as `byte-optimize--lexvars', with shared structure and contents.")
+
+(defvar byte-optimize--vars-outside-loop nil
+ "Alist of variables lexically bound outside the innermost `while' loop.
+Variables here are sensitive to mutation inside the loop, since this can
+occur an indeterminate number of times and thus have effect on code
+sequentially preceding the mutation itself.
+Same format as `byte-optimize--lexvars', with shared structure and contents.")
+
+(defvar byte-optimize--dynamic-vars nil
+ "List of variables declared as dynamic during optimisation.")
+
+(defun byte-optimize--substitutable-p (expr)
+ "Whether EXPR is a constant that can be propagated."
+ ;; Only consider numbers, symbols and strings to be values for substitution
+ ;; purposes. Numbers and symbols are immutable, and mutating string
+ ;; literals (or results from constant-evaluated string-returning functions)
+ ;; can be considered undefined.
+ ;; (What about other quoted values, like conses?)
+ (or (booleanp expr)
+ (numberp expr)
+ (stringp expr)
+ (and (consp expr)
+ (eq (car expr) 'quote)
+ (symbolp (cadr expr)))
+ (keywordp expr)))
+
+(defmacro byte-optimize--pcase (exp &rest cases)
+ ;; When we do
+ ;;
+ ;; (pcase EXP
+ ;; (`(if ,exp ,then ,else) (DO-TEST))
+ ;; (`(plus ,e2 ,e2) (DO-ADD))
+ ;; (`(times ,e2 ,e2) (DO-MULT))
+ ;; ...)
+ ;;
+ ;; we usually don't want to fall back to the default case if
+ ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)'
+ ;; or `(times E1 E2 E3)', instead we either want to signal an error
+ ;; that EXP has an unexpected shape, or we want to carry on as if
+ ;; it had the right shape (ignore the extra data and pretend the missing
+ ;; data is nil) because it should simply never happen.
+ ;;
+ ;; The macro below implements the second option by rewriting patterns
+ ;; like `(if ,exp ,then ,else)'
+ ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'.
+ ;;
+ ;; The resulting macroexpansion is also significantly cleaner/smaller/faster.
+ (declare (indent 1) (debug (form &rest (pcase-PAT body))))
+ `(pcase ,exp
+ . ,(mapcar (lambda (case)
+ `(,(pcase (car case)
+ ((and `(,'\` (,_ . (,'\, ,_))) pat) pat)
+ (`(,'\` (,head . ,tail))
+ (list '\`
+ (cons head
+ (list '\, `(or ,(list '\` tail)
pcase--dontcare)))))
+ (pat pat))
+ . ,(cdr case)))
+ cases)))
+
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@@ -380,13 +394,26 @@
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
- (pcase form
+ (byte-optimize--pcase form
((pred (not consp))
- (if (not (and for-effect
- (or byte-compile-delete-errors
- (not (symbolp form))
- (eq form t))))
- form))
+ (cond
+ ((and for-effect
+ (or byte-compile-delete-errors
+ (not (symbolp form))
+ (eq form t)))
+ nil)
+ ((symbolp form)
+ (let ((lexvar (assq form byte-optimize--lexvars)))
+ (if (cddr lexvar) ; Value available?
+ (if (assq form byte-optimize--vars-outside-loop)
+ ;; Cannot substitute; mark for retention to avoid the
+ ;; variable being eliminated.
+ (progn
+ (setcar (cdr lexvar) t)
+ form)
+ (caddr lexvar)) ; variable value to use
+ form)))
+ (t form)))
(`(quote . ,v)
(if (cdr v)
(byte-compile-warn "malformed quote form: `%s'"
@@ -396,39 +423,28 @@
(and (car v)
(not for-effect)
form))
- (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare))
- ;; Recursively enter the optimizer for the bindings and body
- ;; of a let or let*. This for depth-firstness: forms that
- ;; are more deeply nested are optimized first.
- (cons fn
- (cons
- (mapcar (lambda (binding)
- (if (symbolp binding)
- binding
- (if (cdr (cdr binding))
- (byte-compile-warn "malformed let binding: `%s'"
- (prin1-to-string binding)))
- (list (car binding)
- (byte-optimize-form (nth 1 binding) nil))))
- bindings)
- (byte-optimize-body exps for-effect))))
+ (`(,(or 'let 'let*) . ,rest)
+ (cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
- (cons fn
- (mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- clauses)))
+ ;; The condition in the first clause is always executed, but
+ ;; right now we treat all of them as conditional for simplicity.
+ (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
+ (cons fn
+ (mapcar (lambda (clause)
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses))))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
- (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
+ (`(prog1 ,exp . ,exps)
(if exps
`(prog1 ,(byte-optimize-form exp for-effect)
. ,(byte-optimize-body exps t))
@@ -442,37 +458,60 @@
(cons fn (byte-optimize-body exps for-effect)))
(`(if ,test ,then . ,else)
- `(if ,(byte-optimize-form test nil)
- ,(byte-optimize-form then for-effect)
- . ,(byte-optimize-body else for-effect)))
- (`(if . ,_)
- (byte-compile-warn "too few arguments for `if'"))
+ ;; 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))
+ (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.
- ;; Take forms off the back until we can't any more.
- ;; In the future it could conceivably be a problem that the
- ;; subexpressions of these forms are optimized in the reverse
- ;; order, but it's ok for now.
- (if for-effect
- (let ((backwards (reverse exps)))
- (while (and backwards
- (null (setcar backwards
- (byte-optimize-form (car backwards)
- for-effect))))
- (setq backwards (cdr backwards)))
- (if (and exps (null backwards))
- (byte-compile-log
- " all subforms of %s called for effect; deleted" form))
- (and backwards
- (cons fn (nreverse (mapcar #'byte-optimize-form
- backwards)))))
- (cons fn (mapcar #'byte-optimize-form exps))))
+ ;; FIXME: We have to traverse the expressions in left-to-right
+ ;; order (because that is the order of evaluation and variable
+ ;; mutations must be found prior to their use), but doing so we miss
+ ;; some optimisation opportunities:
+ ;; consider (and A B) in a for-effect context, where B => nil.
+ ;; Then A could be optimised in a for-effect context too.
+ (let ((tail exps)
+ (args nil))
+ (when tail
+ ;; The first argument is always unconditional.
+ (push (byte-optimize-form
+ (car tail) (and for-effect (null (cdr tail))))
+ args)
+ (setq tail (cdr tail))
+ ;; Remaining arguments are conditional.
+ (let ((byte-optimize--vars-outside-condition
byte-optimize--lexvars))
+ (while tail
+ (push (byte-optimize-form
+ (car tail) (and for-effect (null (cdr tail))))
+ args)
+ (setq tail (cdr tail)))))
+ (cons fn (nreverse args))))
(`(while ,exp . ,exps)
- `(while ,(byte-optimize-form exp nil)
- . ,(byte-optimize-body exps t)))
- (`(while . ,_)
- (byte-compile-warn "too few arguments for `while'"))
+ ;; FIXME: We conservatively prevent the substitution of any variable
+ ;; bound outside the loop in case it is mutated later in the loop,
+ ;; but this misses many opportunities: variables not mutated in the
+ ;; loop at all, and variables affecting the initial condition (which
+ ;; is always executed unconditionally).
+ (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars)
+ (byte-optimize--vars-outside-loop byte-optimize--lexvars)
+ (condition (byte-optimize-form exp nil))
+ (body (byte-optimize-body exps t)))
+ `(while ,condition . ,body)))
+
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
@@ -484,25 +523,36 @@
;; all the subexpressions and compiling them separately.
form)
- (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
- `(condition-case ,var ;Not evaluated.
- ,(byte-optimize-form exp for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- clauses)))
-
- (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare))
- ;; The "protected" part of an unwind-protect is compiled (and thus
- ;; optimized) as a top-level form, so don't do it here. But the
- ;; non-protected part has the same for-effect status as the
- ;; unwind-protect itself. (The protected part is always for effect,
+ (`(condition-case ,var ,exp . ,clauses)
+ (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
+ `(condition-case ,var ;Not evaluated.
+ ,(byte-optimize-form exp for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ clauses))))
+
+ (`(unwind-protect ,exp . ,exps)
+ ;; The unwinding part of an unwind-protect is compiled (and thus
+ ;; optimized) as a top-level form, but run the optimizer for it here
+ ;; anyway for lexical variable usage and substitution. But the
+ ;; protected part has the same for-effect status as the
+ ;; unwind-protect itself. (The unwinding part is always for effect,
;; but that isn't handled properly yet.)
- `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps))
-
- (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
- `(catch ,(byte-optimize-form tag nil)
- . ,(byte-optimize-body exps for-effect)))
+ (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars)
+ (bodyform (byte-optimize-form exp for-effect)))
+ (pcase exps
+ (`(:fun-body ,f)
+ `(unwind-protect ,bodyform
+ :fun-body ,(byte-optimize-form f nil)))
+ (_
+ `(unwind-protect ,bodyform
+ . ,(byte-optimize-body exps t))))))
+
+ (`(catch ,tag . ,exps)
+ (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
+ `(catch ,(byte-optimize-form tag nil)
+ . ,(byte-optimize-body exps for-effect))))
(`(ignore . ,exps)
;; Don't treat the args to `ignore' as being
@@ -512,10 +562,17 @@
`(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
;; Needed as long as we run byte-optimize-form after cconv.
- (`(internal-make-closure . ,_) form)
+ (`(internal-make-closure . ,_)
+ ;; Look up free vars and mark them to be kept, so that they
+ ;; won't be optimised away.
+ (dolist (var (caddr form))
+ (let ((lexvar (assq var byte-optimize--lexvars)))
+ (when lexvar
+ (setcar (cdr lexvar) t))))
+ form)
(`((lambda . ,_) . ,_)
- (let ((newform (byte-compile-unfold-lambda form)))
+ (let ((newform (macroexp--unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion.
form
@@ -525,6 +582,35 @@
;; is a *value* and shouldn't appear in the car.
(`((closure . ,_) . ,_) form)
+ (`(setq . ,args)
+ (let ((var-expr-list nil))
+ (while args
+ (unless (and (consp args)
+ (symbolp (car args)) (consp (cdr args)))
+ (byte-compile-warn "malformed setq form: %S" form))
+ (let* ((var (car args))
+ (expr (cadr args))
+ (lexvar (assq var byte-optimize--lexvars))
+ (value (byte-optimize-form expr nil)))
+ (when lexvar
+ ;; Set a new value or inhibit further substitution.
+ (setcdr (cdr lexvar)
+ (and
+ ;; Inhibit if bound outside conditional code.
+ (not (assq var byte-optimize--vars-outside-condition))
+ ;; The new value must be substitutable.
+ (byte-optimize--substitutable-p value)
+ (list value)))
+ (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (push var var-expr-list)
+ (push value var-expr-list))
+ (setq args (cddr args)))
+ (cons fn (nreverse var-expr-list))))
+
+ (`(defvar ,(and (pred symbolp) name) . ,_)
+ (push name byte-optimize--dynamic-vars)
+ form)
+
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
@@ -557,30 +643,84 @@
(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
+ ;; of a let or let*. This for depth-firstness: forms that
+ ;; are more deeply nested are optimized first.
+ (if (and lexical-binding byte-optimize-enable-variable-constprop)
+ (let* ((byte-optimize--lexvars byte-optimize--lexvars)
+ (new-lexvars nil)
+ (let-vars nil))
+ (dolist (binding (car form))
+ (let (name expr)
+ (cond ((consp binding)
+ (setq name (car binding))
+ (unless (symbolp name)
+ (byte-compile-warn "let-bind nonvariable: `%S'" name))
+ (setq expr (byte-optimize-form (cadr binding) nil)))
+ ((symbolp binding)
+ (setq name binding))
+ (t (byte-compile-warn "malformed let binding: `%S'"
binding)))
+ (let* (
+ (value (and (byte-optimize--substitutable-p expr)
+ (list expr)))
+ (lexical (not (or (and (symbolp name)
+ (special-variable-p name))
+ (memq name byte-compile-bound-variables)
+ (memq name byte-optimize--dynamic-vars))))
+ (lexinfo (and lexical (cons name (cons nil value)))))
+ (push (cons name (cons expr (cdr lexinfo))) let-vars)
+ (when lexinfo
+ (push lexinfo (if (eq head 'let*)
+ byte-optimize--lexvars
+ new-lexvars))))))
+ (setq byte-optimize--lexvars
+ (append new-lexvars byte-optimize--lexvars))
+ ;; Walk the body expressions, which may mutate some of the records,
+ ;; and generate new bindings that exclude unused variables.
+ (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars)
+ (opt-body (byte-optimize-body (cdr form) for-effect))
+ (bindings nil))
+ (dolist (var let-vars)
+ ;; VAR is (NAME EXPR [KEEP [VALUE]])
+ (if (and (nthcdr 3 var) (not (nth 2 var)))
+ ;; Value present and not marked to be kept: eliminate.
+ (when byte-optimize-warn-eliminated-variable
+ (byte-compile-warn "eliminating local variable %S" (car
var)))
+ (push (list (nth 0 var) (nth 1 var)) bindings)))
+ (cons bindings opt-body)))
+
+ ;; With dynamic binding, no substitutions are in effect.
+ (let ((byte-optimize--lexvars nil))
+ (cons
+ (mapcar (lambda (binding)
+ (if (symbolp binding)
+ binding
+ (when (or (atom binding) (cddr binding))
+ (byte-compile-warn "malformed let binding: `%S'" binding))
+ (list (car binding)
+ (byte-optimize-form (nth 1 binding) nil))))
+ (car form))
+ (byte-optimize-body (cdr form) for-effect)))))
(defun byte-optimize-body (forms all-for-effect)
@@ -1422,10 +1562,7 @@
;; 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 88f362d..76e7f01 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))
@@ -143,6 +146,18 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''lisp-indent-function (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
@@ -159,7 +174,9 @@ This may shift errors from run-time to compile-time.")
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 'indent #'byte-run--set-indent)
+ (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 9429d6a..1b0906b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -195,7 +195,6 @@ otherwise adds \".elc\"."
(autoload 'byte-optimize-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
-(autoload 'byte-compile-unfold-lambda "byte-opt")
;; This is the entry point to the decompiler, which is used by the
;; disassembler. The disassembler just requires 'byte-compile, but
@@ -2860,7 +2859,9 @@ If FORM is a lambda or a macro, byte-compile it as a
function."
((eq arg '&optional)
(when (memq '&optional (cdr list))
(error "Duplicate &optional")))
- ((memq arg vars)
+ ((and (memq arg vars)
+ ;; Allow repetitions for unused args.
+ (not (string-match "\\`_" (symbol-name arg))))
(byte-compile-warn "repeated variable %s in lambda-list" arg))
(t
(push arg vars))))
@@ -2940,7 +2941,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)
@@ -2951,10 +2953,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,
@@ -2965,15 +2970,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.
@@ -3003,9 +3007,16 @@ for symbols generated by the byte compiler itself."
(list (help-add-fundoc-usage doc arglist)))
((or doc int)
(list doc)))
- ;; optionally, the interactive spec.
- (if int
- (list (nth 1 int))))))))
+ ;; 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)))))))))
(defvar byte-compile-reserved-constants 0)
@@ -3277,7 +3288,7 @@ for symbols generated by the byte compiler itself."
((and (eq (car-safe (car form)) 'lambda)
;; if the form comes out the same way it went in, that's
;; because it was malformed, and we couldn't unfold it.
- (not (eq form (setq form (byte-compile-unfold-lambda form)))))
+ (not (eq form (setq form (macroexp--unfold-lambda form)))))
(byte-compile-form form byte-compile--for-effect)
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 7d760ff..40c17b9 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -187,7 +187,7 @@ Make sure the width/height is correct."
)
"Class used to display an axis which represents different named items.")
-(defclass chart-sequece ()
+(defclass chart-sequence ()
((data :initarg :data
:initform nil)
(name :initarg :name
@@ -583,12 +583,12 @@ SORT-PRED if desired."
))
(iv (eq dir 'vertical)))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data namelst
:name nametitle)
(if iv 'x-axis 'y-axis))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data numlst
:name numtitle)
(if iv 'y-axis 'x-axis))
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 c2bf02c..b9a8a3f 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 5d59585..45e76c7 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
@@ -87,7 +88,6 @@ using, but only when you also use Edebug."
;; because the byte compiler binds them; as a result, if edebug
;; is first loaded for a require in a compilation, they will be left unbound.
-;;;###autoload
(defcustom edebug-all-defs nil
"If non-nil, evaluating defining forms instruments for Edebug.
This applies to `eval-defun', `eval-region', `eval-buffer', and
@@ -100,11 +100,6 @@ variable. You may wish to make it local to each buffer
with
`emacs-lisp-mode-hook'."
:type 'boolean)
-;; edebug-all-defs and edebug-all-forms need to be autoloaded
-;; because the byte compiler binds them; as a result, if edebug
-;; is first loaded for a require in a compilation, they will be left unbound.
-
-;;;###autoload
(defcustom edebug-all-forms nil
"Non-nil means evaluation of all forms will instrument for Edebug.
This doesn't apply to loading or evaluations in the minibuffer.
@@ -244,19 +239,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.
@@ -445,66 +451,24 @@ the option `edebug-all-forms'."
;; We should somehow arrange to be able to do this
;; without actually replacing the eval-defun command.
-(defun edebug-eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar', then reset the
-variable using its initial value expression even if the variable
-already has some other value. (Normally `defvar' does not change the
-variable's value if it already has a value.) Treat `defcustom'
-similarly. Reinitialize the face according to `defface' specification.
-
-With a prefix argument, instrument the code for Edebug.
-
-Setting option `edebug-all-defs' to a non-nil value reverses the meaning
+(defun edebug--eval-defun (orig-fun edebug-it)
+ "Setting option `edebug-all-defs' to a non-nil value reverses the meaning
of the prefix argument. Code is then instrumented when this function is
invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
-just FUNCTION is printed.
+just FUNCTION is printed."
+ (let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
+ (edebug-all-defs edebug-all-forms))
+ (funcall orig-fun nil)))
-If not acting on a `defun', the result of evaluation is displayed in
-the minibuffer."
+(defun edebug-eval-defun (edebug-it)
+ (declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1"))
(interactive "P")
- (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
- (edebug-result)
- (form
- (let ((edebug-all-forms edebugging)
- (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
- (edebug-read-top-level-form))))
- ;; This should be consistent with `eval-defun-1', but not the
- ;; same, since that gets a macroexpanded form.
- (cond ((and (eq (car form) 'defvar)
- (cdr-safe (cdr-safe form)))
- ;; Force variable to be bound.
- (makunbound (nth 1 form)))
- ((and (eq (car form) 'defcustom)
- (default-boundp (nth 1 form)))
- ;; Force variable to be bound.
- ;; FIXME: Shouldn't this use the :setter or :initializer?
- (set-default (nth 1 form) (eval (nth 2 form) lexical-binding)))
- ((eq (car form) 'defface)
- ;; Reset the face.
- (setq face-new-frame-defaults
- (assq-delete-all (nth 1 form) face-new-frame-defaults))
- (put (nth 1 form) 'face-defface-spec nil)
- (put (nth 1 form) 'face-documentation (nth 3 form))
- ;; See comments in `eval-defun-1' for purpose of code below
- (setq form (prog1 `(prog1 ,form
- (put ',(nth 1 form) 'saved-face
- ',(get (nth 1 form) 'saved-face))
- (put ',(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put (nth 1 form) 'saved-face nil)))))
- (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding))
- (if (not edebugging)
- (prog1
- (prin1 edebug-result)
- (let ((str (eval-expression-print-format edebug-result)))
- (if str (princ str))))
- edebug-result)))
-
+ (if (advice-member-p #'edebug--eval-defun 'eval-defun)
+ (eval-defun edebug-it)
+ (edebug--eval-defun #'eval-defun edebug-it)))
;;;###autoload
(defalias 'edebug-defun 'edebug-eval-top-level-form)
@@ -576,12 +540,12 @@ already is one.)"
(defun edebug-install-read-eval-functions ()
(interactive)
(add-function :around load-read-function #'edebug--read)
- (advice-add 'eval-defun :override #'edebug-eval-defun))
+ (advice-add 'eval-defun :around #'edebug--eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
(remove-function load-read-function #'edebug--read)
- (advice-remove 'eval-defun #'edebug-eval-defun))
+ (advice-remove 'eval-defun #'edebug--eval-defun))
;;; Edebug internal data
@@ -961,6 +925,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 +991,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 +1043,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 +1093,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 +1125,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 +1136,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 +1186,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 +1341,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 +1460,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 +1505,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 +1522,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 +1535,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 +1543,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 +1580,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 +1591,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,10 +1637,10 @@ contains a circular object."
(first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
(match (cond
((eq ?& first-char);; "&" symbols take all following specs.
- (funcall (get-edebug-spec 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)))
- (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
+ (edebug--handle-:-spec-op spec cursor (car (cdr specs))))
(t;; Any other normal spec.
(setq rest (cdr specs))
(edebug-match-one-spec cursor spec)))))
@@ -1721,40 +1671,23 @@ contains a circular object."
;; user may want to define macros or functions with the same names.
;; We could use an internal obarray for these primitive specs.
-(dolist (pair '((&optional . edebug-match-&optional)
- (&rest . edebug-match-&rest)
- (&or . edebug-match-&or)
- (form . edebug-match-form)
+(dolist (pair '((form . edebug-match-form)
(sexp . edebug-match-sexp)
(body . edebug-match-body)
- (&define . edebug-match-&define)
- (name . edebug-match-name)
- (:name . edebug-match-colon-name)
- (:unique . edebug-match-:unique)
(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)
- (¬ . edebug-match-¬)
- (&key . edebug-match-&key)
- (&error . edebug-match-&error)
(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)
@@ -1793,13 +1726,12 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(defun edebug-match-&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)))
@@ -1814,20 +1746,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--match-&-spec-op (op cursor specs)
+ "Handle &foo spec operators.
+&foo spec operators operate on all the subsequent SPECS.")
-(defun edebug-match-&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)))))
-(defun edebug-match-&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.
@@ -1851,24 +1787,49 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-
-(defun edebug-match-¬ (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-match-&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
-(defun edebug-match-&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-match-&rest
+ (edebug--match-&-spec-op
+ '&rest
cursor
(cons '&or
(mapcar (lambda (pair)
@@ -1876,7 +1837,7 @@ contains a circular object."
(car (cdr pair))))
specs))))
-(defun edebug-match-&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)))
@@ -1945,19 +1906,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)
@@ -1980,7 +1937,7 @@ contains a circular object."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(defun edebug-match-&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
@@ -1994,47 +1951,67 @@ 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)))
-
-(defun edebug-match-colon-name (_cursor spec)
+(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.
+:foo spec operators operate on just the one subsequent SPEC element.")
+
+(cl-defmethod edebug--handle-:-spec-op ((_ (eql :name)) _cursor spec)
;; Set the edebug-def-name to the spec.
(setq edebug-def-name
(if edebug-def-name
@@ -2043,7 +2020,7 @@ contains a circular object."
spec))
nil)
-(defun edebug-match-:unique (_cursor spec)
+(cl-defmethod edebug--handle-:-spec-op ((_ (eql :unique)) _cursor spec)
"Match a `:unique PREFIX' specifier.
SPEC is the symbol name prefix for `gensym'."
(let ((suffix (gensym spec)))
@@ -2054,63 +2031,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 +2059,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 +2202,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 +2378,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 +2813,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 +2828,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 +3491,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 +3506,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."
@@ -3801,9 +3694,10 @@ Print result in minibuffer."
(interactive (list (read--expression "Eval: ")))
(princ
(edebug-outside-excursion
- (setq values (cons (edebug-eval expr) values))
- (concat (edebug-safe-prin1-to-string (car values))
- (eval-expression-print-format (car values))))))
+ (let ((result (edebug-eval expr)))
+ (values--store-value result)
+ (concat (edebug-safe-prin1-to-string result)
+ (eval-expression-print-format result))))))
(defun edebug-eval-last-sexp (&optional no-truncate)
"Evaluate sexp before point in the outside environment.
@@ -3936,10 +3830,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)
@@ -3972,9 +3870,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 ()
@@ -4236,7 +4134,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)
@@ -4578,13 +4477,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..a02406a 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -100,7 +100,7 @@ If the value is a positive number, it is used to calculate a
number of logical lines of documentation that ElDoc is allowed to
put in the echo area. If a positive integer, the number is used
directly, while a float specifies the number of lines as a
-proporting of the echo area frame's height.
+proportion of the echo area frame's height.
If value is the symbol `truncate-sym-name-if-fit' t, the part of
the doc string that represents a symbol's name may be truncated
@@ -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
@@ -691,7 +692,7 @@ following values are allowed:
- `eldoc-documentation-compose-eagerly': calls all functions in
the special hook and display as many of the resulting doc
- strings as possible, as soon as possibl. Preserving the
+ strings as possible, as soon as possible. Preserving the
relative order of doc strings;
- `eldoc-documentation-enthusiast': calls all functions in the
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/generator.el b/lisp/emacs-lisp/generator.el
index 9eb6d95..e45260c 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -725,17 +725,20 @@ Return the value with which ITERATOR finished iteration."
(condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cps--gensym "iter-do-iterator"))
(result-symbol (cps--gensym "iter-do-result")))
- `(let (,var
- ,result-symbol
+ `(let (,result-symbol
(,done-symbol nil)
(,it-symbol ,iterator))
- (while (not ,done-symbol)
- (condition-case ,condition-symbol
- (setf ,var (iter-next ,it-symbol))
- (iter-end-of-sequence
- (setf ,result-symbol (cdr ,condition-symbol))
- (setf ,done-symbol t)))
- (unless ,done-symbol ,@body))
+ (while
+ (let ((,var
+ (condition-case ,condition-symbol
+ (iter-next ,it-symbol)
+ (iter-end-of-sequence
+ (setf ,result-symbol (cdr ,condition-symbol))
+ (setf ,done-symbol t)))))
+ (unless ,done-symbol
+ ,@body
+ ;; Loop until done-symbol is set.
+ t)))
,result-symbol)))
(defvar cl--loop-args)
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/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index adb9cb2..6d9c8c3 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -495,7 +495,7 @@ absent, return nil."
(concat "^;;;[[:blank:]]*\\("
lm-commentary-header
"\\):[[:blank:]\n]*")
- "^;;[[:blank:]]*" ; double semicolon prefix
+ "^;;[[:blank:]]?" ; double semicolon prefix
"[[:blank:]\n]*\\'") ; trailing new-lines
"" (buffer-substring-no-properties
start (lm-commentary-end))))))))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index f5ce107..54089c4 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -62,9 +62,6 @@
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table)
- ;; This is probably obsolete since nowadays such features use overlays.
- ;; ;; Give CR the same syntax as newline, for selective-display.
- ;; (modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\; "< " table)
(modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e842222..0934e43 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -200,6 +200,69 @@ and also to avoid outputting the warning during normal
execution."
new-form))
new-form)))
+(defun macroexp--unfold-lambda (form &optional name)
+ ;; In lexical-binding mode, let and functions don't bind vars in the same way
+ ;; (let obey special-variable-p, but functions don't). But luckily, this
+ ;; doesn't matter here, because function's behavior is underspecified so it
+ ;; can safely be turned into a `let', even though the reverse is not true.
+ (or name (setq name "anonymous lambda"))
+ (let* ((lambda (car form))
+ (values (cdr form))
+ (arglist (nth 1 lambda))
+ (body (cdr (cdr lambda)))
+ optionalp restp
+ bindings)
+ (if (and (stringp (car body)) (cdr body))
+ (setq body (cdr body)))
+ (if (and (consp (car body)) (eq 'interactive (car (car body))))
+ (setq body (cdr body)))
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr arglist))
+ (error "nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car arglist) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in arglists.
+ (if (null (cdr arglist))
+ (error "nothing after &rest in %s" name))
+ (if (cdr (cdr arglist))
+ (error "multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car arglist)
+ (and values (cons 'list values)))
+ bindings)
+ values nil))
+ ((and (not optionalp) (null values))
+ (setq arglist nil values 'too-few))
+ (t
+ (setq bindings (cons (list (car arglist) (car values))
+ bindings)
+ values (cdr values))))
+ (setq arglist (cdr arglist)))
+ (if values
+ (macroexp--warn-and-return
+ (format (if (eq values 'too-few)
+ "attempt to open-code `%s' with too few arguments"
+ "attempt to open-code `%s' with too many arguments")
+ name)
+ form)
+
+ ;; The following leads to infinite recursion when loading a
+ ;; file containing `(defsubst f () (f))', and then trying to
+ ;; byte-compile that file.
+ ;;(setq body (mapcar 'byte-optimize-form body)))
+
+ (if bindings
+ `(let ,(nreverse bindings) . ,body)
+ (macroexp-progn body)))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
@@ -236,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)
@@ -245,12 +313,8 @@ Assumes the caller has bound
`macroexpand-all-environment'."
;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the
optimizer
;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
;; creation of a closure, thus resulting in much better code.
- (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
- 'macroexp--not-unfolded
- ;; Don't unfold if byte-opt is not yet loaded.
- (byte-compile-unfold-lambda form))))
- (if (or (eq newform 'macroexp--not-unfolded)
- (eq newform form))
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
;; Unfolding failed for some reason, avoid infinite recursion.
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
@@ -513,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/package.el b/lisp/emacs-lisp/package.el
index 90b7b88..092befa 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2802,6 +2802,7 @@ either a full name or nil, and EMAIL is a valid email
address."
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
+ :interactive nil
(setq mode-line-process '((package--downloads-in-progress ":Loading")
(package-menu--transaction-status
package-menu--transaction-status)))
@@ -2924,7 +2925,7 @@ Installed obsolete packages are always displayed.")
Also hide packages whose name matches a regexp in user option
`package-hidden-regexps' (a list). To add regexps to this list,
use `package-menu-hide-package'."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(setq package-menu--hide-packages
(not package-menu--hide-packages))
@@ -3261,7 +3262,7 @@ To unhide a package, type
Type \\[package-menu-toggle-hiding] to toggle package hiding."
(declare (interactive-only "change `package-hidden-regexps' instead."))
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let* ((name (when (derived-mode-p 'package-menu-mode)
(concat "\\`" (regexp-quote (symbol-name (package-desc-name
@@ -3285,7 +3286,7 @@ Type \\[package-menu-toggle-hiding] to toggle package
hiding."
(defun package-menu-describe-package (&optional button)
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkg-desc (if button (button-get button 'package-desc)
(tabulated-list-get-id))))
(if pkg-desc
@@ -3295,7 +3296,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status)
'("installed" "dependency" "obsolete" "unsigned"))
@@ -3304,7 +3305,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status) '("available" "avail-obso" "new"
"dependency"))
(tabulated-list-put-tag "I" t)
@@ -3312,20 +3313,20 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-mark-unmark (&optional _num)
"Clear any marks on a package and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(tabulated-list-put-tag " " t))
(defun package-menu-backup-unmark ()
"Back up one line and clear any marks on that package."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(forward-line -1)
(tabulated-list-put-tag " "))
(defun package-menu-mark-obsolete-for-deletion ()
"Mark all obsolete packages for deletion."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(save-excursion
(goto-char (point-min))
@@ -3356,7 +3357,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-quick-help ()
"Show short key binding help for `package-menu-mode'.
The full list of keys can be viewed with \\[describe-mode]."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(message (mapconcat #'package--prettify-quick-help-key
package--quick-help-keys "\n")))
@@ -3452,7 +3453,7 @@ call will upgrade the package.
If there's an async refresh operation in progress, the flags will
be placed as part of `package-menu--post-refresh' instead of
immediately."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(if (not package--downloads-in-progress)
(package-menu--mark-upgrades-1)
@@ -3546,7 +3547,7 @@ packages list, respectively."
Packages marked for installation are downloaded and installed;
packages marked for deletion are removed.
Optional argument NOQUERY non-nil means do not ask the user to confirm."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let (install-list delete-list cmd pkg-desc)
(save-excursion
@@ -3791,7 +3792,8 @@ strings. If ARCHIVE is nil or the empty string, show all
packages."
(interactive (list (completing-read-multiple
"Filter by archive (comma separated): "
- (mapcar #'car package-archives))))
+ (mapcar #'car package-archives)))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(let ((re (if (listp archive)
(regexp-opt archive)
@@ -3812,7 +3814,8 @@ DESCRIPTION.
When called interactively, prompt for DESCRIPTION.
If DESCRIPTION is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by description (regexp)")))
+ (interactive (list (read-regexp "Filter by description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not description) (string-empty-p description))
(package-menu--generate t t)
@@ -3833,10 +3836,11 @@ strings. If KEYWORD is nil or the empty string, show
all
packages."
(interactive (list (completing-read-multiple
"Keywords (comma separated): "
- (package-all-keywords))))
+ (package-all-keywords)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(when (stringp keyword)
(setq keyword (list keyword)))
- (package--ensure-package-menu-mode)
(if (not keyword)
(package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc)
@@ -3855,7 +3859,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION.
If NAME-OR-DESCRIPTION is nil or the empty string, show all
packages."
- (interactive (list (read-regexp "Filter by name or description (regexp)")))
+ (interactive (list (read-regexp "Filter by name or description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name-or-description) (string-empty-p name-or-description))
(package-menu--generate t t)
@@ -3874,7 +3879,8 @@ Display only packages with name that matches regexp NAME.
When called interactively, prompt for NAME.
If NAME is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by name (regexp)")))
+ (interactive (list (read-regexp "Filter by name (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
(package-menu--generate t t)
@@ -3904,7 +3910,8 @@ packages."
"incompat"
"installed"
"new"
- "unsigned"))))
+ "unsigned")))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not status) (string-empty-p status))
(package-menu--generate t t)
@@ -3939,7 +3946,9 @@ If VERSION is nil or the empty string, show all packages."
('< "< less than")
('> "> greater than"))
"): "))
- choice))))
+ choice)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(unless (equal predicate 'quit)
(if (or (not version) (string-empty-p version))
(package-menu--generate t t)
@@ -3957,7 +3966,7 @@ If VERSION is nil or the empty string, show all packages."
(defun package-menu-filter-marked ()
"Filter \"*Packages*\" buffer by non-empty upgrade mark.
Unlike other filters, this leaves the marks intact."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(widen)
(let (found-entries mark pkg-id entry marks)
@@ -3985,7 +3994,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
(package-menu--filter-by
(lambda (pkg)
@@ -3994,7 +4003,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(package-menu--generate t t))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ec746fa..c7288b7 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,
@@ -662,7 +642,7 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-pred (vars upat pat)
"Indicate the overlap or mutual-exclusion between UPAT and PAT.
-More specifically retuns a pair (A . B) where A indicates whether PAT
+More specifically returns a pair (A . B) where A indicates whether PAT
can match when UPAT has matched, and B does the same for the case
where UPAT failed to match.
A and B can be one of:
@@ -804,7 +784,7 @@ Otherwise, it defers to REST which is a list of branches of
the form
\(ELSE-MATCH ELSE-CODE . ELSE-VARS)."
;; Depending on the order in which we choose to check each of the MATCHES,
;; the resulting tree may be smaller or bigger. So in general, we'd want
- ;; to be careful to chose the "optimal" order. But predicate
+ ;; to be careful to choose the "optimal" order. But predicate
;; patterns make this harder because they create dependencies
;; between matches. So we don't bother trying to reorder anything.
(cond
@@ -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/pp.el b/lisp/emacs-lisp/pp.el
index ef4c960..2fd4724 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -127,8 +127,9 @@ Also add the value to the front of the list in the variable
`values'."
(interactive
(list (read--expression "Eval: ")))
(message "Evaluating...")
- (push (eval expression lexical-binding) values)
- (pp-display-expression (car values) "*Pp Eval Output*"))
+ (let ((result (eval expression lexical-binding)))
+ (values--store-value result)
+ (pp-display-expression result "*Pp Eval Output*")))
;;;###autoload
(defun pp-macroexpand-expression (expression)
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index b29b870..58584f3 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)."
(* (or (seq "[:" (+ (any "a-z")) ":]")
(not (any "]"))))
"]")
- anything
+ (not (any "*+?^$[\\"))
(seq "\\"
(or anything
(seq (any "sScC_") anything)
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/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index fb9cd8f..12b0dcf 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -6,6 +6,8 @@
;; Keywords: spreadsheet lisp utility
;; Package: testcover
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 312e387..75b27d0 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -258,10 +258,10 @@ vector. Return VALUE."
(aset testcover-vector after-index (testcover--copy-object value)))
((eq 'maybe old-result)
(aset testcover-vector after-index 'edebug-ok-coverage))
- ((eq '1value old-result)
+ ((eq 'testcover-1value old-result)
(aset testcover-vector after-index
(cons old-result (testcover--copy-object value))))
- ((and (eq (car-safe old-result) '1value)
+ ((and (eq (car-safe old-result) 'testcover-1value)
(not (condition-case ()
(equal (cdr old-result) value)
(circular-list t))))
@@ -358,11 +358,11 @@ eliminated by adding more test cases."
data (aref coverage len))
(when (and (not (eq data 'edebug-ok-coverage))
(not (memq (car-safe data)
- '(1value maybe noreturn)))
+ '(testcover-1value maybe noreturn)))
(setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
- (if (memq data '(edebug-unknown maybe 1value))
+ (if (memq data '(edebug-unknown maybe testcover-1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@@ -450,12 +450,12 @@ or return multiple values."
(`(defconst ,sym . ,args)
(push sym testcover-module-constants)
(testcover-analyze-coverage-progn args)
- '1value)
+ 'testcover-1value)
(`(defun ,name ,_ . ,doc-and-body)
(let ((val (testcover-analyze-coverage-progn doc-and-body)))
(cl-case val
- ((1value) (push name testcover-module-1value-functions))
+ ((testcover-1value) (push name testcover-module-1value-functions))
((maybe) (push name testcover-module-potentially-1value-functions)))
nil))
@@ -466,13 +466,13 @@ or return multiple values."
;; To avoid infinite recursion, don't examine quoted objects.
;; This will cause the coverage marks on an instrumented quoted
;; form to look odd. See bug#25316.
- '1value)
+ 'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
((or 't 'nil (pred keywordp))
- '1value)
+ 'testcover-1value)
((pred vectorp)
(testcover-analyze-coverage-compose (append form nil)
@@ -482,7 +482,7 @@ or return multiple values."
nil)
((pred atom)
- '1value)
+ 'testcover-1value)
(_
;; Whatever we have here, it's not wrapped, so treat it as a list of
forms.
@@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or
nil
depending on the analysis of the last one. Find the coverage
vectors referenced by `edebug-enter' forms nested within FORMS and
update them with the results of the analysis."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-analyze-coverage (pop forms))))
result))
@@ -518,7 +518,7 @@ form to be treated accordingly."
(setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
(when (or (eq wrapper '1value) val)
;; The form is 1-valued or potentially 1-valued.
- (aset testcover-vector after-id (or val '1value)))
+ (aset testcover-vector after-id (or val 'testcover-1value)))
(cond
((or (eq wrapper 'noreturn)
@@ -526,13 +526,13 @@ form to be treated accordingly."
;; This function won't return, so indicate to testcover-before that
;; it should record coverage.
(aset testcover-vector before-id (cons 'noreturn after-id))
- (aset testcover-vector after-id '1value)
- (setq val '1value))
+ (aset testcover-vector after-id 'testcover-1value)
+ (setq val 'testcover-1value))
((eq (car-safe wrapped-form) '1value)
;; This function is always supposed to return the same value.
- (setq val '1value)
- (aset testcover-vector after-id '1value)))
+ (setq val 'testcover-1value)
+ (aset testcover-vector after-id 'testcover-1value)))
val))
(defun testcover-analyze-coverage-wrapped-form (form)
@@ -540,26 +540,26 @@ form to be treated accordingly."
FORM is treated as if it will be evaluated."
(pcase form
((pred keywordp)
- '1value)
+ 'testcover-1value)
((pred symbolp)
(when (or (memq form testcover-constants)
(memq form testcover-module-constants))
- '1value))
+ 'testcover-1value))
((pred atom)
- '1value)
+ 'testcover-1value)
(`(\` ,bq-form)
(testcover-analyze-coverage-backquote-form bq-form))
(`(defconst ,sym ,val . ,_)
(push sym testcover-module-constants)
(testcover-analyze-coverage val)
- '1value)
+ 'testcover-1value)
(`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body)
;; These always return RESULT if provided.
(testcover-analyze-coverage expr)
(testcover-analyze-coverage-progn body)
(let ((val (testcover-analyze-coverage-progn result)))
;; If the third value is not present, the loop always returns nil.
- (if result val '1value)))
+ (if result val 'testcover-1value)))
(`(,(or 'let 'let*) ,bindings . ,body)
(testcover-analyze-coverage-progn bindings)
(testcover-analyze-coverage-progn body))
@@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated."
(defun testcover-analyze-coverage-wrapped-application (func args)
"Analyze the application of FUNC to ARGS for code coverage."
(cond
- ((eq func 'quote) '1value)
+ ((eq func 'quote) 'testcover-1value)
((or (memq func testcover-1value-functions)
(memq func testcover-module-1value-functions))
;; The function should always return the same value.
(testcover-analyze-coverage-progn args)
- '1value)
+ 'testcover-1value)
((or (memq func testcover-potentially-1value-functions)
(memq func testcover-module-potentially-1value-functions))
;; The function might always return the same value.
@@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either
argument is maybe, return maybe. Return 1value only if both arguments
are 1value."
(cl-case val
- (1value result)
+ (testcover-1value result)
(maybe (and result 'maybe))
(nil nil)))
(defun testcover-analyze-coverage-compose (forms func)
"Analyze a list of FORMS for code coverage using FUNC.
The list is 1valued if all of its constituent elements are also 1valued."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp forms)
(setq result (testcover-coverage-combine result (funcall func (car
forms))))
(setq forms (cdr forms)))
@@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are
also 1valued."
(defun testcover-analyze-coverage-backquote (bq-list)
"Analyze BQ-LIST, the body of a backquoted list, for code coverage."
- (let ((result '1value))
+ (let ((result 'testcover-1value))
(while (consp bq-list)
(let ((form (car bq-list))
val)
@@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are
also 1valued."
"Analyze a single FORM from a backquoted list for code coverage."
(cond
((vectorp form) (testcover-analyze-coverage-backquote (append form nil)))
- ((atom form) '1value)
+ ((atom form) 'testcover-1value)
((memq (car form) (list '\, '\,@))
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))
diff --git a/lisp/epa.el b/lisp/epa.el
index 197cd92..572c947 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -379,8 +379,7 @@ DOC is documentation text to insert at the start."
(goto-char point))
(epa--insert-keys (epg-list-keys context name secret)))
- (make-local-variable 'epa-list-keys-arguments)
- (setq epa-list-keys-arguments (list name secret))
+ (setq-local epa-list-keys-arguments (list name secret))
(goto-char (point-min))
(pop-to-buffer (current-buffer)))
@@ -500,8 +499,7 @@ If SECRET is non-nil, list secret keys instead of public
keys."
(format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
(set-buffer (cdr entry))
(epa-key-mode)
- (make-local-variable 'epa-key)
- (setq epa-key key)
+ (setq-local epa-key key)
(erase-buffer)
(setq pointer (epg-key-user-id-list key))
(while pointer
diff --git a/lisp/epg.el b/lisp/epg.el
index 36794d0..36515ef 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -641,22 +641,14 @@ callback data (if any)."
(with-current-buffer buffer
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
- (make-local-variable 'epg-last-status)
- (setq epg-last-status nil)
- (make-local-variable 'epg-read-point)
- (setq epg-read-point (point-min))
- (make-local-variable 'epg-process-filter-running)
- (setq epg-process-filter-running nil)
- (make-local-variable 'epg-pending-status-list)
- (setq epg-pending-status-list nil)
- (make-local-variable 'epg-key-id)
- (setq epg-key-id nil)
- (make-local-variable 'epg-context)
- (setq epg-context context)
- (make-local-variable 'epg-agent-file)
- (setq epg-agent-file agent-file)
- (make-local-variable 'epg-agent-mtime)
- (setq epg-agent-mtime agent-mtime))
+ (setq-local epg-last-status nil)
+ (setq-local epg-read-point (point-min))
+ (setq-local epg-process-filter-running nil)
+ (setq-local epg-pending-status-list nil)
+ (setq-local epg-key-id nil)
+ (setq-local epg-context context)
+ (setq-local epg-agent-file agent-file)
+ (setq-local epg-agent-mtime agent-mtime))
(setq error-process
(make-pipe-process :name "epg-error"
:buffer (generate-new-buffer " *epg-error*")
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-imenu.el b/lisp/erc/erc-imenu.el
index 1a2d8e2..ecdfc2a 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -73,13 +73,11 @@ Don't rely on this function, read it first!"
(topic-change-alist '())
prev-pos)
(goto-char (point-max))
- (imenu-progress-message prev-pos 0)
(while (if (bolp)
(> (forward-line -1)
-1)
(progn (forward-line 0)
t))
- (imenu-progress-message prev-pos nil t)
(save-match-data
(when (looking-at (concat (regexp-quote erc-notice-prefix)
"\\(.+\\)$"))
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 ab4c7c5..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.
@@ -89,7 +89,7 @@ for use on `completion-at-point-function'."
(defun pcomplete-erc-setup ()
"Setup `erc-mode' to use pcomplete."
- (setq-local pcomplete-ignore-case t)
+ (setq-local completion-ignore-case t)
(setq-local pcomplete-use-paring nil)
(setq-local pcomplete-parse-arguments-function
#'pcomplete-erc-parse-arguments)
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/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 638c0ac..cbfe0b8 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -150,8 +150,8 @@ to writing a completion function."
:type (get 'pcomplete-dir-ignore 'custom-type))
(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
- (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case)
- :type (get 'pcomplete-ignore-case 'custom-type))
+ (eshell-cmpl--custom-variable-docstring 'completion-ignore-case)
+ :type (get 'completion-ignore-case 'custom-type))
(defcustom eshell-cmpl-autolist nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-autolist)
@@ -259,7 +259,7 @@ to writing a completion function."
eshell-cmpl-file-ignore)
(setq-local pcomplete-dir-ignore
eshell-cmpl-dir-ignore)
- (setq-local pcomplete-ignore-case
+ (setq-local completion-ignore-case
eshell-cmpl-ignore-case)
(setq-local pcomplete-autolist
eshell-cmpl-autolist)
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/face-remap.el b/lisp/face-remap.el
index 7fbf0c4..5914ee4 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -354,9 +354,9 @@ INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
key-binding used to invoke the command, with all modifiers removed:
- +, = Increase the default face height by one step
- - Decrease the default face height by one step
- 0 Reset the default face height to the global default
+ +, = Increase the height of the default face by one step
+ - Decrease the height of the default face by one step
+ 0 Reset the height of the default face to the global default
After adjusting, continue to read input events and further adjust
the face height as long as the input event read
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index dc5f8f4..6290b02 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -85,10 +85,6 @@
;;; Code:
-;; Global bindings:
-(define-key global-map [C-down-mouse-2] 'facemenu-menu)
-(define-key global-map "\M-o" 'facemenu-keymap)
-
(defgroup facemenu nil
"Create a face menu for interactively adding fonts to text."
:group 'faces
diff --git a/lisp/files.el b/lisp/files.el
index dada69c..68e8835 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1639,7 +1639,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))
@@ -2530,13 +2530,11 @@ unless NOMODES is non-nil."
(msg
(cond
((not warn) nil)
- ((and error (file-attributes buffer-file-name))
+ ((and error (file-exists-p buffer-file-name))
(setq buffer-read-only t)
- (if (and (file-symlink-p buffer-file-name)
- (not (file-exists-p
- (file-chase-links buffer-file-name))))
- "Symbolic link that points to nonexistent file"
- "File exists, but cannot be read"))
+ "File exists, but cannot be read")
+ ((and error (file-symlink-p buffer-file-name))
+ "Symbolic link that points to nonexistent file")
((not buffer-read-only)
(if (and warn
;; No need to warn if buffer is auto-saved
@@ -2553,13 +2551,12 @@ unless NOMODES is non-nil."
((not error)
(setq not-serious t)
"Note: file is write protected")
- ((file-attributes (directory-file-name default-directory))
+ ((file-accessible-directory-p default-directory)
"File not found and directory write-protected")
- ((file-exists-p (file-name-directory buffer-file-name))
- (setq buffer-read-only nil))
(t
(setq buffer-read-only nil)
- "Use M-x make-directory RET RET to create the directory and its
parents"))))
+ (unless (file-directory-p default-directory)
+ "Use M-x make-directory RET RET to create the directory and its
parents")))))
(when msg
(message "%s" msg)
(or not-serious (sit-for 1 t))))
diff --git a/lisp/frame.el b/lisp/frame.el
index 0aae87b..10d1d14 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1370,6 +1370,7 @@ FRAME defaults to the selected frame."
FRAME defaults to the selected frame."
(setq frame (window-normalize-frame frame))
(- (frame-native-height frame)
+ (tab-bar-height frame t)
(* 2 (frame-internal-border-width frame))))
(defun frame-outer-width (&optional frame)
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 4c6e118..0f4e1ae 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -23,7 +23,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file contains a collection of generic modes.
;;
;; INSTALLATION:
@@ -32,17 +32,6 @@
;;
;; (require 'generic-x)
;;
-;; You can decide which modes to load by setting the variable
-;; `generic-extras-enable-list'. Its default value is platform-
-;; specific. The recommended way to set this variable is through
-;; customize:
-;;
-;; M-x customize-option RET generic-extras-enable-list RET
-;;
-;; This lets you select generic modes from the list of available
-;; modes. If you manually set `generic-extras-enable-list' in your
-;; .emacs, do it BEFORE loading generic-x with (require 'generic-x).
-;;
;; You can also send in new modes; if the file types are reasonably
;; common, we would like to install them.
;;
@@ -184,88 +173,7 @@ This hook will be installed if the variable
;; Other Generic modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; If you add a generic mode to this file, put it in one of these four
-;; lists as well.
-
-(defconst generic-default-modes
- '(apache-conf-generic-mode
- apache-log-generic-mode
- hosts-generic-mode
- java-manifest-generic-mode
- java-properties-generic-mode
- javascript-generic-mode
- show-tabs-generic-mode
- vrml-generic-mode)
- "List of generic modes that are defined by default.")
-
-(defconst generic-mswindows-modes
- '(bat-generic-mode
- inf-generic-mode
- ini-generic-mode
- rc-generic-mode
- reg-generic-mode
- rul-generic-mode)
- "List of generic modes that are defined by default on MS-Windows.")
-
-(defconst generic-unix-modes
- '(alias-generic-mode
- ansible-inventory-generic-mode
- etc-fstab-generic-mode
- etc-modules-conf-generic-mode
- etc-passwd-generic-mode
- etc-services-generic-mode
- etc-sudoers-generic-mode
- fvwm-generic-mode
- inetd-conf-generic-mode
- mailagent-rules-generic-mode
- mailrc-generic-mode
- named-boot-generic-mode
- named-database-generic-mode
- prototype-generic-mode
- resolve-conf-generic-mode
- samba-generic-mode
- x-resource-generic-mode
- xmodmap-generic-mode)
- "List of generic modes that are defined by default on Unix.")
-
-(defconst generic-other-modes
- '(astap-generic-mode
- ibis-generic-mode
- pkginfo-generic-mode
- spice-generic-mode)
- "List of generic modes that are not defined by default.")
-
-(defcustom generic-extras-enable-list
- (append generic-default-modes
- (if (memq system-type '(windows-nt ms-dos))
- generic-mswindows-modes
- generic-unix-modes)
- nil)
- "List of generic modes to define.
-Each entry in the list should be a symbol. If you set this variable
-directly, without using customize, you must reload generic-x to put
-your changes into effect."
- :type (let (list)
- (dolist (mode
- (sort (append generic-default-modes
- generic-mswindows-modes
- generic-unix-modes
- generic-other-modes
- nil)
- (lambda (a b)
- (string< (symbol-name b)
- (symbol-name a))))
- (cons 'set list))
- (push `(const ,mode) list)))
- :set (lambda (s v)
- (set-default s v)
- (unless load-in-progress
- (load "generic-x")))
- :version "22.1")
-
;;; Apache
-(when (memq 'apache-conf-generic-mode generic-extras-enable-list)
-
(define-generic-mode apache-conf-generic-mode
'(?#)
nil
@@ -278,9 +186,7 @@ your changes into effect."
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
- "Generic mode for Apache or HTTPD configuration files."))
-
-(when (memq 'apache-log-generic-mode generic-extras-enable-list)
+ "Generic mode for Apache or HTTPD configuration files.")
(define-generic-mode apache-log-generic-mode
nil
@@ -291,11 +197,9 @@ your changes into effect."
(2 font-lock-variable-name-face)))
'("access_log\\'")
nil
- "Generic mode for Apache log files."))
+ "Generic mode for Apache log files.")
;;; Samba
-(when (memq 'samba-generic-mode generic-extras-enable-list)
-
(define-generic-mode samba-generic-mode
'(?\; ?#)
nil
@@ -305,13 +209,11 @@ your changes into effect."
(2 font-lock-type-face)))
'("smb\\.conf\\'")
'(generic-bracket-support)
- "Generic mode for Samba configuration files."))
+ "Generic mode for Samba configuration files.")
;;; Fvwm
;; This is pretty basic. Also, modes for other window managers could
;; be defined as well.
-(when (memq 'fvwm-generic-mode generic-extras-enable-list)
-
(define-generic-mode fvwm-generic-mode
'(?#)
'("AddToMenu"
@@ -330,33 +232,28 @@ your changes into effect."
nil
'("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
nil
- "Generic mode for FVWM configuration files."))
+ "Generic mode for FVWM configuration files.")
;;; X Resource
;; I'm pretty sure I've seen an actual mode to do this, but I don't
;; think it's standard with Emacs
-(when (memq 'x-resource-generic-mode generic-extras-enable-list)
-
(define-generic-mode x-resource-generic-mode
'(?!)
nil
'(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
'("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
nil
- "Generic mode for X Resource configuration files."))
+ "Generic mode for X Resource configuration files.")
-(if (memq 'xmodmap-generic-mode generic-extras-enable-list)
(define-generic-mode xmodmap-generic-mode
'(?!)
'("add" "clear" "keycode" "keysym" "remove" "pointer")
nil
'("[xX]modmap\\(rc\\)?\\'")
nil
- "Simple mode for xmodmap files."))
+ "Simple mode for xmodmap files.")
;;; Hosts
-(when (memq 'hosts-generic-mode generic-extras-enable-list)
-
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
@@ -364,27 +261,20 @@ your changes into effect."
("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
- "Generic mode for HOSTS files."))
+ "Generic mode for HOSTS files.")
;;; Windows INF files
-;; If i-g-m-f-f-h is defined, then so is i-g-m.
-(declare-function ini-generic-mode "generic-x")
-
-(when (memq 'inf-generic-mode generic-extras-enable-list)
-
(define-generic-mode inf-generic-mode
'(?\;)
nil
'(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
'("\\.[iI][nN][fF]\\'")
'(generic-bracket-support)
- "Generic mode for MS-Windows INF files."))
+ "Generic mode for MS-Windows INF files.")
;;; Windows INI files
;; Should define escape character as well!
-(when (memq 'ini-generic-mode generic-extras-enable-list)
-
(define-generic-mode ini-generic-mode
'(?\;)
nil
@@ -411,13 +301,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
-(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
- 'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
-(when (memq 'reg-generic-mode generic-extras-enable-list)
-
(define-generic-mode reg-generic-mode
'(?\;)
'("key" "classes_root" "REGEDIT" "REGEDIT4")
@@ -428,19 +314,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
- "Generic mode for MS-Windows Registry files."))
-
-(declare-function w32-shell-name "w32-fns" ())
-
-;;; DOS/Windows BAT files
-(when (memq 'bat-generic-mode generic-extras-enable-list)
- (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4"))
+ "Generic mode for MS-Windows Registry files.")
;;; Mailagent
;; Mailagent is a Unix mail filtering program. Anyone wanna do a
;; generic mode for procmail?
-(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list)
-
(define-generic-mode mailagent-rules-generic-mode
'(?#)
'("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT")
@@ -451,11 +329,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
- "Generic mode for Mailagent rules files."))
+ "Generic mode for Mailagent rules files.")
;; Solaris/Sys V prototype files
-(when (memq 'prototype-generic-mode generic-extras-enable-list)
-
(define-generic-mode prototype-generic-mode
'(?#)
nil
@@ -474,11 +350,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("prototype\\'")
nil
- "Generic mode for Sys V prototype files."))
+ "Generic mode for Sys V prototype files.")
;; Solaris/Sys V pkginfo files
-(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
-
(define-generic-mode pkginfo-generic-mode
'(?#)
nil
@@ -487,17 +361,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("pkginfo\\'")
nil
- "Generic mode for Sys V pkginfo files."))
-
-;; Javascript mode
-;; Obsolete; defer to js-mode from js.el.
-(when (memq 'javascript-generic-mode generic-extras-enable-list)
- (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
- (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3"))
+ "Generic mode for Sys V pkginfo files.")
;; VRML files
-(when (memq 'vrml-generic-mode generic-extras-enable-list)
-
(define-generic-mode vrml-generic-mode
'(?#)
'("DEF"
@@ -545,11 +411,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1)))))
- "Generic Mode for VRML files."))
+ "Generic Mode for VRML files.")
;; Java Manifests
-(when (memq 'java-manifest-generic-mode generic-extras-enable-list)
-
(define-generic-mode java-manifest-generic-mode
'(?#)
'("Name"
@@ -566,11 +430,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-constant-face)))
'("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
nil
- "Generic mode for Java Manifest files."))
+ "Generic mode for Java Manifest files.")
;; Java properties files
-(when (memq 'java-properties-generic-mode generic-extras-enable-list)
-
(define-generic-mode java-properties-generic-mode
'(?! ?#)
nil
@@ -596,11 +458,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
- "Generic mode for Java properties files."))
+ "Generic mode for Java properties files.")
;; C shell alias definitions
-(when (memq 'alias-generic-mode generic-extras-enable-list)
-
(define-generic-mode alias-generic-mode
'(?#)
'("alias" "unalias")
@@ -613,11 +473,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
- "Generic mode for C Shell alias files."))
+ "Generic mode for C Shell alias files.")
;; Ansible inventory files
-(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list)
-
(define-generic-mode ansible-inventory-generic-mode
'(?#)
nil
@@ -636,12 +494,10 @@ like an INI file. You can add this hook to
`find-file-hook'."
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
- "Generic mode for Ansible inventory files."))
+ "Generic mode for Ansible inventory files.")
;;; Windows RC files
;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
-(when (memq 'rc-generic-mode generic-extras-enable-list)
-
(define-generic-mode rc-generic-mode
;; '(?\/)
'("//")
@@ -721,15 +577,13 @@ like an INI file. You can add this hook to
`find-file-hook'."
'("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))))
- '("\\.[rR][cC]\\'")
- nil
- "Generic mode for MS-Windows Resource files."))
+ '("\\.[rR][cC]\\'")
+ nil
+ "Generic mode for MS-Windows Resource files.")
;; InstallShield RUL files
;; Contributed by Alfred.Correira@Pervasive.Com
;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com>
-(when (memq 'rul-generic-mode generic-extras-enable-list)
-
(eval-when-compile
;;; build the regexp strings using regexp-opt
@@ -1372,11 +1226,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
> "begin" \n
> _ \n
resume:
- > "end;"))
+ > "end;")
;; Additions by ACorreir@pervasive-sw.com (Alfred Correira)
-(when (memq 'mailrc-generic-mode generic-extras-enable-list)
-
(define-generic-mode mailrc-generic-mode
'(?#)
'("alias"
@@ -1398,11 +1250,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.mailrc\\'")
nil
- "Mode for mailrc files."))
+ "Mode for mailrc files.")
;; Inetd.conf
-(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
-
(define-generic-mode inetd-conf-generic-mode
'(?#)
'("stream"
@@ -1417,11 +1267,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
;; Services
-(when (memq 'etc-services-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-services-generic-mode
'(?#)
'("tcp"
@@ -1434,11 +1282,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
;; Password and Group files
-(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-passwd-generic-mode
nil ;; No comment characters
'("root") ;; Only one keyword
@@ -1476,11 +1322,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))
;; Fstab
-(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
@@ -1592,11 +1436,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
+ '((nil "^\\([^# \t]+\\)\\s-+" 1))))))
;; /etc/sudoers
-(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-sudoers-generic-mode
'(?#)
'("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias"
@@ -1607,11 +1449,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face))
'("/etc/sudoers\\'")
nil
- "Generic mode for sudoers configuration files."))
+ "Generic mode for sudoers configuration files.")
;; From Jacques Duthen <jacques.duthen@sncf.fr>
-(when (memq 'show-tabs-generic-mode generic-extras-enable-list)
-
(eval-when-compile
(defconst show-tabs-generic-mode-font-lock-defaults-1
@@ -1649,14 +1489,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
nil ;; no auto-mode-alist
;; '(show-tabs-generic-mode-hook-fun)
nil
- "Generic mode to show tabs and trailing spaces."))
+ "Generic mode to show tabs and trailing spaces.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DNS modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(when (memq 'named-boot-generic-mode generic-extras-enable-list)
-
(define-generic-mode named-boot-generic-mode
;; List of comment characters
'(?\;)
@@ -1672,9 +1510,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/named\\.boot\\'")
;; List of set up functions to call
- nil))
-
-(when (memq 'named-database-generic-mode generic-extras-enable-list)
+ nil)
(define-generic-mode named-database-generic-mode
;; List of comment characters
@@ -1695,9 +1531,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
(defun named-database-print-serial ()
"Print a serial number based on the current date."
(interactive)
- (insert (format-time-string named-database-time-string))))
-
-(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
+ (insert (format-time-string named-database-time-string)))
(define-generic-mode resolve-conf-generic-mode
;; List of comment characters
@@ -1709,14 +1543,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional auto-mode-alist expressions
'("/etc/resolve?\\.conf\\'")
;; List of set up functions to call
- nil))
+ nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modes for spice and common electrical engineering circuit netlist formats
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(when (memq 'spice-generic-mode generic-extras-enable-list)
-
(define-generic-mode spice-generic-mode
nil
'("and"
@@ -1752,9 +1584,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for SPICE circuit netlist files."))
-
-(when (memq 'ibis-generic-mode generic-extras-enable-list)
+ "Generic mode for SPICE circuit netlist files.")
(define-generic-mode ibis-generic-mode
'(?|)
@@ -1763,9 +1593,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[iI][bB][sS]\\'")
'(generic-bracket-support)
- "Generic mode for IBIS circuit netlist files."))
-
-(when (memq 'astap-generic-mode generic-extras-enable-list)
+ "Generic mode for IBIS circuit netlist files.")
(define-generic-mode astap-generic-mode
nil
@@ -1799,9 +1627,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for ASTAP circuit netlist files."))
-
-(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
+ "Generic mode for ASTAP circuit netlist files.")
(define-generic-mode etc-modules-conf-generic-mode
;; List of comment characters
@@ -1843,7 +1669,98 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/modules\\.conf" "/etc/conf\\.modules")
;; List of set up functions to call
- nil))
+ nil)
+
+;; Obsolete
+
+(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3")
+(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3")
+
+(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4")
+
+(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
+ #'ini-generic-mode-find-file-hook "28.1")
+
+(defconst generic-default-modes
+ '(apache-conf-generic-mode
+ apache-log-generic-mode
+ hosts-generic-mode
+ java-manifest-generic-mode
+ java-properties-generic-mode
+ javascript-generic-mode
+ show-tabs-generic-mode
+ vrml-generic-mode)
+ "List of generic modes that are defined by default.")
+(make-obsolete-variable 'generic-default-modes "no longer used." "28.1")
+
+(defconst generic-mswindows-modes
+ '(bat-generic-mode
+ inf-generic-mode
+ ini-generic-mode
+ rc-generic-mode
+ reg-generic-mode
+ rul-generic-mode)
+ "List of generic modes that are defined by default on MS-Windows.")
+(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1")
+
+(defconst generic-unix-modes
+ '(alias-generic-mode
+ ansible-inventory-generic-mode
+ etc-fstab-generic-mode
+ etc-modules-conf-generic-mode
+ etc-passwd-generic-mode
+ etc-services-generic-mode
+ etc-sudoers-generic-mode
+ fvwm-generic-mode
+ inetd-conf-generic-mode
+ mailagent-rules-generic-mode
+ mailrc-generic-mode
+ named-boot-generic-mode
+ named-database-generic-mode
+ prototype-generic-mode
+ resolve-conf-generic-mode
+ samba-generic-mode
+ x-resource-generic-mode
+ xmodmap-generic-mode)
+ "List of generic modes that are defined by default on Unix.")
+(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1")
+
+(defconst generic-other-modes
+ '(astap-generic-mode
+ ibis-generic-mode
+ pkginfo-generic-mode
+ spice-generic-mode)
+ "List of generic modes that are not defined by default.")
+(make-obsolete-variable 'generic-other-modes "no longer used." "28.1")
+
+(defcustom generic-extras-enable-list
+ (append generic-default-modes
+ (if (memq system-type '(windows-nt ms-dos))
+ generic-mswindows-modes
+ generic-unix-modes)
+ nil)
+ "List of generic modes to define.
+Each entry in the list should be a symbol. If you set this variable
+directly, without using customize, you must reload generic-x to put
+your changes into effect."
+ :type (let (list)
+ (dolist (mode
+ (sort (append generic-default-modes
+ generic-mswindows-modes
+ generic-unix-modes
+ generic-other-modes
+ nil)
+ (lambda (a b)
+ (string< (symbol-name b)
+ (symbol-name a))))
+ (cons 'set list))
+ (push `(const ,mode) list)))
+ :set (lambda (s v)
+ (set-default s v)
+ (unless load-in-progress
+ (load "generic-x")))
+ :version "22.1")
+(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1")
(provide 'generic-x)
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 70ededf..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,20 +4321,16 @@ 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)))
-(defmacro gnus--\,@ (exp)
- (declare (debug t))
- `(progn ,@(eval exp t)))
-
(gnus--\,@
(mapcar (lambda (func)
`(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)
@@ -4756,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)
@@ -4800,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
@@ -4810,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)
@@ -4952,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)
@@ -4969,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)
@@ -5065,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))
@@ -5078,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)
@@ -5120,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)
@@ -5169,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)))
@@ -5179,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)))
@@ -5188,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)
@@ -5218,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
@@ -5257,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
@@ -5313,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)
@@ -5341,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)
@@ -5439,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)
@@ -5479,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)
@@ -5501,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)
@@ -5522,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
@@ -5615,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)
@@ -5697,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)))
@@ -6387,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
@@ -6492,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)
@@ -6545,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)))
@@ -6553,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)))
@@ -6576,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))
@@ -6632,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)
@@ -6673,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)
@@ -6685,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)
@@ -6695,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 ()
@@ -6707,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"
@@ -6818,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)))
@@ -6826,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))
@@ -6848,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))
@@ -6875,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))
@@ -6934,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))
@@ -6952,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))
@@ -6978,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)
@@ -7273,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"))
@@ -7306,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))
@@ -7340,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))
@@ -7361,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)
@@ -7879,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))
@@ -7892,9 +7897,10 @@ 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
- (mouse-set-point event)
+ (when event
+ (mouse-set-point event))
(let ((fun (get-text-property (point) 'gnus-callback)))
(when fun
(funcall fun (get-text-property (point) 'gnus-data))))))
@@ -7905,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)
@@ -7917,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)
@@ -7958,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
@@ -7981,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)
@@ -8075,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)
@@ -8123,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
@@ -8239,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))
@@ -8431,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)
@@ -8439,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)
@@ -8463,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)
@@ -8471,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)
@@ -8605,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)
@@ -8731,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))
@@ -8888,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-search.el b/lisp/gnus/gnus-search.el
index f3e0851..339bff9 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -4,18 +4,20 @@
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -363,7 +365,7 @@ This variable can also be set per-server."
"A list of strings representing expandable search keys.
\"Expandable\" simply means the key can be abbreviated while
typing in search queries, ie \"subject\" could be entered as
-\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subj\" or even \"su\", though \"s\" is ambiguous between
\"subject\" and \"since\".
Ambiguous abbreviations will raise an error."
@@ -400,7 +402,7 @@ The search \"language\" is essentially a series of key:value
expressions. Key is most often a mail header, but there are
other keys. Value is a string, quoted if it contains spaces.
Key and value are separated by a colon, no space. Expressions
-are implictly ANDed; the \"or\" keyword can be used to
+are implicitly ANDed; the \"or\" keyword can be used to
OR. \"not\" will negate the following expression, or keys can be
prefixed with a \"-\". The \"near\" operator will work for
engines that understand it; other engines will convert it to
@@ -446,7 +448,7 @@ auto-completion of contact names and addresses for keys like
Date values (any key in `gnus-search-date-keys') can be provided
in any format that `parse-time-string' can parse (note that this
can produce weird results). Dates with missing bits will be
-interpreted as the most recent occurance thereof (ie \"march 03\"
+interpreted as the most recent occurence thereof (ie \"march 03\"
is the most recent March 3rd). Lastly, relative specifications
such as 1d (one day ago) are understood. This also accepts w, m,
and y. m is assumed to be 30 days.
@@ -644,7 +646,7 @@ gnus-*-mark marks, and return an appropriate string."
"Return a string from the current buffer.
If DELIMITED is non-nil, assume the next character is a delimiter
character, and return everything between point and the next
-occurance of the delimiter, including the delimiters themselves.
+occurence of the delimiter, including the delimiters themselves.
If TRIM is non-nil, do not return the delimiters. Otherwise,
return one word."
;; This function cannot handle nested delimiters, as it's not a
@@ -787,7 +789,7 @@ the files in ARTLIST by that search key.")
(raw-queries-p
:initform (symbol-value 'gnus-search-imap-raw-queries-p)))
:documentation
- "The base IMAP search engine, using an IMAP server's search capabilites.
+ "The base IMAP search engine, using an IMAP server's search capabilities.
This backend may be subclassed to handle particular IMAP servers'
quirks.")
@@ -1040,7 +1042,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; A bit of backward-compatibility slash convenience: if the
;; query string doesn't start with any known IMAP search
;; keyword, assume it is a "TEXT" search.
- (unless (or (looking-at "(")
+ (unless (or (eql ?\( (aref q-string 0))
(and (string-match "\\`[^[:blank:]]+" q-string)
(memql (intern-soft (downcase
(match-string 0 q-string)))
@@ -1080,7 +1082,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
(query string))
"Create the IMAP search command for QUERY.
-Currenly takes into account support for the LITERAL+ capability.
+Currently takes into account support for the LITERAL+ capability.
Other capabilities could be tested here."
(with-slots (literal-plus) engine
(when literal-plus
@@ -1346,12 +1348,14 @@ Returns a list of [group article score] vectors."
(let ((prefix (slot-value engine 'remove-prefix))
(group-regexp (when groups
(mapconcat
- (lambda (x)
- (replace-regexp-in-string
- ;; Accept any of [.\/] as path separators.
- "[.\\/]" "[.\\\\/]"
- (gnus-group-real-name x)))
- groups "\\|")))
+ (lambda (group-name)
+ (mapconcat #'regexp-quote
+ (split-string
+ (gnus-group-real-name group-name)
+ "[.\\/]")
+ "[.\\\\/]"))
+ groups
+ "\\|")))
artlist vectors article group)
(goto-char (point-min))
(while (not (eobp))
@@ -1514,6 +1518,7 @@ Namazu provides a little more information, for instance a
score."
(when (re-search-forward
"^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
nil t)
+ (forward-line 1)
(list (match-string 4)
(match-string 3))))
@@ -1667,8 +1672,8 @@ and \"-\" before marks."
(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
(expr (head or)))
"Handle Mairix \"or\" statement.
-Mairix only accepts \"or\" expressions on homogenous keys. We
-cast \"or\" expressions on heterogenous keys as \"and\", which
+Mairix only accepts \"or\" expressions on homogeneous keys. We
+cast \"or\" expressions on heterogeneous keys as \"and\", which
isn't quite right, but it's the best we can do. For date keys,
only keep one of the terms."
(let ((term1 (caadr expr))
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 e7d1cf8..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)))
@@ -627,7 +628,14 @@ articles in the topic and its subtopics."
(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
&optional unread)
+ (gnus--\,@
+ (let ((vars '(indentation visible name level number-of-groups
+ total-number-of-articles entries)))
+ `((with-suppressed-warnings ((lexical ,@vars))
+ ,@(mapcar (lambda (s) `(defvar ,s)) vars)))))
(let* ((visible (if visiblep "" "..."))
+ (level level)
+ (name name)
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(total-number-of-articles unread)
(number-of-groups (length entries))
@@ -640,14 +648,7 @@ articles in the topic and its subtopics."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec
- `((indentation . ,indentation)
- (visible . ,visible)
- (name . ,name)
- (level . ,level)
- (number-of-groups . ,number-of-groups)
- (total-number-of-articles . ,total-number-of-articles)
- (entries . ,entries))))
+ (eval gnus-topic-line-format-spec t))
(list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-unread unread
@@ -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-util.el b/lisp/gnus/gnus-util.el
index 3c7c948..f80243c 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1068,6 +1068,11 @@ ARG is passed to the first function."
;;; Various
+(defmacro gnus--\,@ (exp)
+ "Splice EXP's value (a list of Lisp forms) into the code."
+ (declare (debug t))
+ `(progn ,@(eval exp t)))
+
(defvar gnus-group-buffer) ; Compiler directive
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
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 84e53da..0334b81 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))))
@@ -3212,9 +3220,9 @@ that that variable is buffer-local to the summary
buffers."
(format "%s" (car method))
(format "%s:%s" (car method) (cadr method))))
(name-method (cons name method)))
- (when (and (not (member name-method gnus-server-method-cache))
- (not no-enter-cache)
- (not (assoc (car name-method) gnus-server-method-cache)))
+ (unless (or no-enter-cache
+ (member name-method gnus-server-method-cache)
+ (assoc (car name-method) gnus-server-method-cache))
(push name-method gnus-server-method-cache))
name)))
@@ -3273,8 +3281,7 @@ that that variable is buffer-local to the summary
buffers."
(gnus-server-to-method method))
((equal method gnus-select-method)
gnus-select-method)
- ((and (stringp (car method))
- group)
+ ((and group (stringp (car method)))
(gnus-server-extend-method group method))
((and method
(not group)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 6668784..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))
@@ -4315,6 +4320,10 @@ It should typically alter the sending method in some way
or other."
(when message-confirm-send
(or (y-or-n-p "Send message? ")
(keyboard-quit)))
+ (when (and (not (mml-secure-is-encrypted-p))
+ (mml-secure-is-encrypted-p 'anywhere)
+ (not (yes-or-no-p "This message has a <#secure tag, but is not
going to be encrypted. Send anyway?")))
+ (error "Aborting sending"))
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
@@ -4568,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"))
@@ -5740,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))))
@@ -6043,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
@@ -6129,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
@@ -6347,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)
@@ -6545,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))
@@ -6870,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)
@@ -8210,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))
@@ -8587,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
@@ -8674,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
@@ -8742,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
@@ -8765,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")
@@ -8776,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))
@@ -8812,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 8d01d15..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,53 +259,56 @@ 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 ()
- "Check whether secure encrypt tag is present."
+(defun mml-secure-is-encrypted-p (&optional tag-present)
+ "Whether the current buffer contains a mail message that should be encrypted.
+If TAG-PRESENT, say whether the <#secure tag is present anywhere
+in the buffer."
(save-excursion
(goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"
- "<#secure[^>]+encrypt")
- nil t)))
+ (message-goto-body)
+ (if tag-present
+ (re-search-forward "<#secure[^>]+encrypt" nil t)
+ (skip-chars-forward "[ \t\n")
+ (looking-at "<#secure[^>]+encrypt"))))
(defun mml-secure-bcc-is-safe ()
"Check whether usage of Bcc is safe (or absent).
@@ -355,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)
@@ -366,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))
@@ -375,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))
@@ -384,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/nnselect.el b/lisp/gnus/nnselect.el
index fffa2d2..1daa8aa 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -33,7 +33,7 @@
;; turn be a vector of three elements: a real prefixed group name, an
;; article number in that group, and an integer score. The score is
;; not used by nnselect but may be used by other code to help in
-;; sorting. Most functions will just chose a fixed number, such as
+;; sorting. Most functions will just choose a fixed number, such as
;; 100, for this score.
;; For example the search function `gnus-search-run-query' applied to
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 b03a440..ceb6bc0 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1743,7 +1743,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)
@@ -1766,19 +1766,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)))
@@ -1827,9 +1827,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/help-mode.el b/lisp/help-mode.el
index 79710a1..30a1ce0 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -54,14 +54,30 @@
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
["Previous Topic" help-go-back
- :help "Go back to previous topic in this help buffer"]
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
["Next Topic" help-go-forward
- :help "Go back to next topic in this help buffer"]
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]
["Move to Previous Button" backward-button
:help "Move to the Previous Button in the help buffer"]
["Move to Next Button" forward-button
:help "Move to the Next Button in the help buffer"]))
+(defvar help-mode-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (tool-bar-local-item "close" 'quit-window 'quit map
+ :label "Quit help."
+ :vert-only t)
+ (define-key-after map [separator-1] menu-bar-separator)
+ (tool-bar-local-item "search" 'isearch-forward 'search map
+ :label "Search" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map
+ :rtl "right-arrow" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map
help-mode-map
+ :rtl "left-arrow" :vert-only t)
+ map))
+
(defvar-local help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
Used by `help-follow' and `help-xref-go-back'.
@@ -317,6 +333,8 @@ Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
#'help-mode-revert-buffer)
+ (setq-local tool-bar-map
+ help-mode-tool-bar-map)
(setq-local bookmark-make-record-function
#'help-bookmark-make-record))
@@ -778,8 +796,8 @@ help buffer by other means."
(&optional no-file no-context posn))
(defun help-bookmark-make-record ()
- "Create and return a help-mode bookmark record.
-Implements `bookmark-make-record-function' for help-mode buffers."
+ "Create and return a `help-mode' bookmark record.
+Implements `bookmark-make-record-function' for `help-mode' buffers."
(unless (car help-xref-stack-item)
(error "Cannot create bookmark - help command not known"))
`(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
@@ -792,7 +810,7 @@ Implements `bookmark-make-record-function' for help-mode
buffers."
;;;###autoload
(defun help-bookmark-jump (bookmark)
- "Jump to help-mode bookmark BOOKMARK.
+ "Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((help-fn (bookmark-prop-get bookmark 'help-fn))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 9ed295e..7384abf 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -858,7 +858,9 @@ was inserted."
(setq image-transform-rotation
(or (exif-orientation
(ignore-error exif-error
- (exif-parse-buffer)))
+ ;; exif-parse-buffer can move point, so preserve it.
+ (save-excursion
+ (exif-parse-buffer))))
0.0)))
;; Swap width and height when changing orientation
;; between portrait and landscape.
@@ -985,7 +987,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/imenu.el b/lisp/imenu.el
index 2a557e0..7fc57c1 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -36,14 +36,6 @@
;; A mode-specific function is called to generate the index. It is
;; then presented to the user, who can choose from this index.
-;;
-;; The package comes with a set of example functions for how to
-;; utilize this package.
-
-;; There are *examples* for index gathering functions/regular
-;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
-;; customize for other modes. A function for jumping to the chosen
-;; index position is also supplied.
;;; History:
;; Thanks go to
@@ -81,25 +73,20 @@ Setting this to nil makes Imenu work a little faster but
editing the
buffer will make the generated index positions wrong.
This might not yet be honored by all index-building functions."
- :type 'boolean
- :group 'imenu)
-
+ :type 'boolean)
(defcustom imenu-max-item-length 60
"If a number, truncate Imenu entries to that length."
:type '(choice integer
- (const :tag "Unlimited"))
- :group 'imenu)
+ (const :tag "Unlimited")))
(defcustom imenu-auto-rescan nil
"Non-nil means Imenu should always rescan the buffers."
- :type 'boolean
- :group 'imenu)
+ :type 'boolean)
(defcustom imenu-auto-rescan-maxout 600000
"Imenu auto-rescan is disabled in buffers larger than this size (in bytes)."
:type 'integer
- :group 'imenu
:version "26.2")
(defcustom imenu-use-popup-menu 'on-mouse
@@ -109,13 +96,11 @@ If t, always use a popup menu,
If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
:type '(choice (const :tag "On Mouse" on-mouse)
(const :tag "Never" nil)
- (other :tag "Always" t))
- :group 'imenu)
+ (other :tag "Always" t)))
(defcustom imenu-eager-completion-buffer t
"If non-nil, eagerly popup the completion buffer."
:type 'boolean
- :group 'imenu
:version "22.1")
(defcustom imenu-after-jump-hook nil
@@ -123,8 +108,7 @@ If `on-mouse' use a popup menu when `imenu' was invoked
with the mouse."
Useful things to use here include `reposition-window', `recenter', and
\(lambda () (recenter 0)) to show at top of screen."
- :type 'hook
- :group 'imenu)
+ :type 'hook)
;;;###autoload
(defcustom imenu-sort-function nil
@@ -143,39 +127,23 @@ element should come before the second. The arguments are
cons cells;
\(NAME . POSITION). Look at `imenu--sort-by-name' for an example."
:type '(choice (const :tag "No sorting" nil)
(const :tag "Sort by name" imenu--sort-by-name)
- (function :tag "Another function"))
- :group 'imenu)
+ (function :tag "Another function")))
(defcustom imenu-max-items 25
"Maximum number of elements in a mouse menu for Imenu."
- :type 'integer
- :group 'imenu)
-
-;; No longer used. KFS 2004-10-27
-;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
-;; "Progress message during the index scanning of the buffer.
-;; If non-nil, user gets a message during the scanning of the buffer.
-;;
-;; Relevant only if the mode-specific function that creates the buffer
-;; index use `imenu-progress-message', and not useful if that is fast, in
-;; which case you might as well set this to nil."
-;; :type '(choice string
-;; (const :tag "None" nil))
-;; :group 'imenu)
+ :type 'integer)
(defcustom imenu-space-replacement "."
"The replacement string for spaces in index names.
Used when presenting the index in a completion buffer to make the
names work as tokens."
- :type '(choice string (const nil))
- :group 'imenu)
+ :type '(choice string (const nil)))
(defcustom imenu-level-separator ":"
"The separator between index names of different levels.
Used for making mouse-menu titles and for flattening nested indexes
with name concatenation."
- :type 'string
- :group 'imenu)
+ :type 'string)
(defcustom imenu-generic-skip-comments-and-strings t
"When non-nil, ignore text inside comments and strings.
@@ -183,7 +151,6 @@ Only affects `imenu-default-create-index-function' (and any
alternative implementation of `imenu-create-index-function' that
uses `imenu--generic-function')."
:type 'boolean
- :group 'imenu
:version "24.4")
;;;###autoload
@@ -280,26 +247,11 @@ The function in this variable is called when selecting a
normal index-item.")
(not (functionp (cadr item)))))
(defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
- "Macro to display a progress message.
-RELPOS is the relative position to display.
-If RELPOS is nil, then the relative position in the buffer
-is calculated.
-PREVPOS is the variable in which we store the last position displayed."
-
+ "This macro is obsolete and does nothing."
+ (declare (obsolete nil "28.1"))
;; Made obsolete/empty, as computers are now faster than the eye, and
;; it had problems updating the messages correctly, and could shadow
;; more important messages/prompts in the minibuffer. KFS 2004-10-27.
-
-;; `(and
-;; imenu-scanning-message
-;; (let ((pos ,(if relpos
-;; relpos
-;; `(imenu--relative-position ,reverse))))
-;; (if ,(if relpos t
-;; `(> pos (+ 5 ,prevpos)))
-;; (progn
-;; (message imenu-scanning-message pos)
-;; (setq ,prevpos pos)))))
)
diff --git a/lisp/indent.el b/lisp/indent.el
index 4a55507..285b8e2 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -250,7 +250,8 @@ It is activated by calling `indent-rigidly' interactively.")
If called interactively with no prefix argument, activate a
transient mode in which the indentation can be adjusted interactively
by typing \\<indent-rigidly-map>\\[indent-rigidly-left],
\\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or
\\[indent-rigidly-right-to-tab-stop].
-Typing any other key exits this mode. If `transient-mark-mode' is enabled,
+Typing any other key exits this mode, and this key is then
+acted upon as normally. If `transient-mark-mode' is enabled,
exiting also deactivates the mark.
If called from a program, or interactively with prefix ARG,
@@ -524,7 +525,7 @@ From the beginning of the line, moves past the left-margin
indentation, the
fill-prefix, and any indentation used for centering or right-justifying the
line, but does not move past any whitespace that was explicitly inserted
\(such as a tab used to indent the first line of a paragraph)."
- (interactive "p")
+ (interactive "^p")
(beginning-of-line n)
(skip-chars-forward " \t")
;; Skip over fill-prefix.
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/international/characters.el b/lisp/international/characters.el
index 9bce419..c643f66 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -265,7 +265,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
-(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x2975)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index d0b0471..da75adb 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3077,12 +3077,47 @@ on encoding."
(puthash "BELL (BEL)" ?\a names)
(setq ucs-names names))))
+(defun mule--ucs-names-sort-by-code (names)
+ (let ((codes-and-names
+ (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)))
+ (mapcar #'cdr (sort codes-and-names #'car-less-than-car))))
+
(defun mule--ucs-names-affixation (names)
(mapcar (lambda (name)
(let ((char (gethash name ucs-names)))
- (list name (concat (if char (format "%c" char) " ") "\t") "")))
+ (list name (concat (if char (list char) " ") "\t") "")))
names))
+(defun mule--ucs-names-group (names)
+ (let* ((codes-and-names
+ (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))
+ (grouped
+ (seq-group-by
+ (lambda (code-name)
+ (let ((script (aref char-script-table (car code-name))))
+ (if script (symbol-name script) "ungrouped")))
+ codes-and-names))
+ names-with-header header)
+ (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b)))))
+ (setq header t)
+ (dolist (code-name (cdr group))
+ (push (list
+ (cdr code-name)
+ (concat
+ (if header
+ (progn
+ (setq header nil)
+ (concat "\n" (propertize
+ (format "* %s\n" (car group))
+ 'face 'header-line)))
+ "")
+ ;; prefix
+ (if (car code-name) (format "%c" (car code-name)) " ") "\t")
+ ;; suffix
+ "")
+ names-with-header)))
+ (nreverse names-with-header)))
+
(defun char-from-name (string &optional ignore-case)
"Return a character as a number from its Unicode name STRING.
If optional IGNORE-CASE is non-nil, ignore case in STRING.
@@ -3104,6 +3139,23 @@ Return nil if STRING does not name a character."
ignore-case))
code)))))))
+(defcustom read-char-by-name-sort nil
+ "How to sort characters for `read-char-by-name' completion.
+Defines the sorting order either by character names or their codepoints."
+ :type '(choice
+ (const :tag "Sort by character names" nil)
+ (const :tag "Sort by character codepoints" code))
+ :group 'mule
+ :version "28.1")
+
+(defcustom read-char-by-name-group nil
+ "How to group characters for `read-char-by-name' completion.
+When t, split characters to sections of Unicode blocks
+sorted alphabetically."
+ :type 'boolean
+ :group 'mule
+ :version "28.1")
+
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
@@ -3117,6 +3169,9 @@ preceded by an asterisk `*' and use completion, it will
show all
the characters whose names include that substring, not necessarily
at the beginning of the name.
+The options `read-char-by-name-sort' and `read-char-by-name-group'
+define the sorting order of completion characters and how to group them.
+
Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
number like \"2A10\", or a number in hash notation (e.g.,
\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for
@@ -3130,8 +3185,14 @@ as names, not numbers."
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata
- (affixation-function . mule--ucs-names-affixation)
+ `(metadata
+ (display-sort-function
+ . ,(when (eq read-char-by-name-sort 'code)
+ #'mule--ucs-names-sort-by-code))
+ (affixation-function
+ . ,(if read-char-by-name-group
+ #'mule--ucs-names-group
+ #'mule--ucs-names-affixation))
(category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
diff --git a/lisp/isearch.el b/lisp/isearch.el
index b58ca8a..8266c4b 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -3356,7 +3356,7 @@ the word mode."
(defun isearch-lazy-count-format (&optional suffix-p)
"Format the current match number and the total number of matches.
-When SUFFIX-P is non-nil, the returned string is indended for
+When SUFFIX-P is non-nil, the returned string is intended for
isearch-message-suffix prompt. Otherwise, for isearch-message-prefix."
(let ((format-string (if suffix-p
lazy-count-suffix-format
@@ -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/jsonrpc.el b/lisp/jsonrpc.el
index 7f5aa82..f1fb6c1 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -10,18 +10,20 @@
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
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 e835cf0..5ea8728 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -253,8 +253,6 @@
(load "startup")
(load "term/tty-colors")
(load "font-core")
-;; facemenu must be loaded before font-lock, because `facemenu-keymap'
-;; needs to be defined when font-lock is loaded.
(load "facemenu")
(load "emacs-lisp/syntax")
(load "font-lock")
@@ -484,6 +482,31 @@ lost after dumping")))
;; Make sure we will attempt bidi reordering henceforth.
(setq redisplay--inhibit-bidi nil)
+
+;; Experimental feature removal.
+(define-key global-map "\M-o" #'removed-facemenu-command)
+
+(defun removed-facemenu-command ()
+ "Transition command during test period for facemenu removal."
+ (interactive)
+ (switch-to-buffer "*Facemenu Removal*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert-file-contents
+ (expand-file-name "facemenu-removal.txt" data-directory)))
+ (goto-char (point-min))
+ (special-mode))
+
+(defun facemenu-keymap-restore ()
+ "Restore the facemenu keymap."
+ ;; Global bindings:
+ (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 "\M-o" 'font-lock-fontify-block))
+
+
(if dump-mode
(let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp")
((equal dump-mode "dump") "emacs")
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index ad2dee5..83125a0 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -1,4 +1,4 @@
-;;; mail-utils.el --- utility functions used both by rmail and rnews
+;;; mail-utils.el --- utility functions used both by rmail and rnews -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -46,6 +46,7 @@ also the To field, unless this would leave an empty To field."
:type '(choice regexp (const :tag "Your Name" nil))
:group 'mail)
+(defvar epa-inhibit)
;; Returns t if file FILE is an Rmail file.
;;;###autoload
(defun mail-file-babyl-p (file)
@@ -58,6 +59,7 @@ also the To field, unless this would leave an empty To field."
(defun mail-string-delete (string start end)
"Return a string containing all of STRING except the part
from START (inclusive) to END (exclusive)."
+ ;; FIXME: This is not used anywhere. Make obsolete?
(if (null end) (substring string 0 start)
(concat (substring string 0 start)
(substring string end nil))))
diff --git a/lisp/man.el b/lisp/man.el
index 1fded38..70b8aa8 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual
pages."
;;;###autoload
(defun man-follow (man-args)
"Get a Un*x manual page of the item under point and put it in a buffer."
- (interactive (list (Man-default-man-entry)))
+ (interactive (list (Man-default-man-entry)) Man-mode)
(if (or (not man-args)
(string= man-args ""))
(error "No item under point")
@@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear."
(defun Man-update-manpage ()
"Reformat current manpage by calling the man command again synchronously."
- (interactive)
+ (interactive nil Man-mode)
(when (eq Man-arguments nil)
;;this shouldn't happen unless it is not in a Man buffer."
(error "Man-arguments not initialized"))
@@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different
notification behaviors."
(defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
- (interactive)
+ (interactive nil Man-mode)
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face)
@@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the
buttons."
Normally skip any jobs that should have been done by the sed script,
but when called interactively, do those jobs even if the sed
script would have done them."
- (interactive "p")
+ (interactive "p" Man-mode)
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
@@ -1723,7 +1723,7 @@ The following key bindings are currently in effect in the
buffer:
(defun Man-next-section (n)
"Move point to Nth next section (default 1)."
- (interactive "p")
+ (interactive "p" Man-mode)
(let ((case-fold-search nil)
(start (point)))
(if (looking-at Man-heading-regexp)
@@ -1739,7 +1739,7 @@ The following key bindings are currently in effect in the
buffer:
(defun Man-previous-section (n)
"Move point to Nth previous section (default 1)."
- (interactive "p")
+ (interactive "p" Man-mode)
(let ((case-fold-search nil))
(if (looking-at Man-heading-regexp)
(forward-line -1))
@@ -1756,8 +1756,7 @@ Returns t if section is found, nil otherwise."
(if (re-search-forward (concat "^" section) (point-max) t)
(progn (beginning-of-line) t)
(goto-char curpos)
- nil)
- ))
+ nil)))
(defvar Man--last-section nil)
@@ -1771,7 +1770,8 @@ Returns t if section is found, nil otherwise."
(prompt (concat "Go to section (default " default "): "))
(chosen (completing-read prompt Man--sections
nil nil nil nil default)))
- (list chosen)))
+ (list chosen))
+ Man-mode)
(setq Man--last-section section)
(unless (Man-find-section section)
(error "Section %s not found" section)))
@@ -1780,7 +1780,7 @@ Returns t if section is found, nil otherwise."
(defun Man-goto-see-also-section ()
"Move point to the \"SEE ALSO\" section.
Actually the section moved to is described by `Man-see-also-regexp'."
- (interactive)
+ (interactive nil Man-mode)
(if (not (Man-find-section Man-see-also-regexp))
(error "%s" (concat "No " Man-see-also-regexp
" section found in the current manpage"))))
@@ -1834,7 +1834,8 @@ Specify which REFERENCE to use; default is based on word
at point."
(prompt (concat "Refer to (default " default "): "))
(chosen (completing-read prompt Man--refpages
nil nil nil nil defaults)))
- chosen))))
+ chosen)))
+ Man-mode)
(if (not Man--refpages)
(error "Can't find any references in the current manpage")
(setq Man--last-refpage reference)
@@ -1843,7 +1844,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-kill ()
"Kill the buffer containing the manpage."
- (interactive)
+ (interactive nil Man-mode)
(quit-window t))
(defun Man-goto-page (page &optional noerror)
@@ -1854,7 +1855,8 @@ Specify which REFERENCE to use; default is based on word
at point."
(if (= (length Man-page-list) 1)
(error "You're looking at the only manpage in the buffer")
(list (read-minibuffer (format "Go to manpage [1-%d]: "
- (length Man-page-list)))))))
+ (length Man-page-list))))))
+ Man-mode)
(if (and (not Man-page-list) (not noerror))
(error "Not a man page buffer"))
(when Man-page-list
@@ -1876,7 +1878,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-next-manpage ()
"Find the next manpage entry in the buffer."
- (interactive)
+ (interactive nil Man-mode)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (< Man-current-page (length Man-page-list))
@@ -1887,7 +1889,7 @@ Specify which REFERENCE to use; default is based on word
at point."
(defun Man-previous-manpage ()
"Find the previous manpage entry in the buffer."
- (interactive)
+ (interactive nil Man-mode)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (> Man-current-page 1)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 5be13c9..0717f7c 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -636,9 +636,9 @@ Do the same for the keys of the same name."
:help "Customize value of specific option"))
(bindings--define-key menu [separator-2]
menu-bar-separator)
- (bindings--define-key menu [customize-changed-options]
- '(menu-item "New Options..." customize-changed-options
- :help "Options added or changed in recent Emacs versions"))
+ (bindings--define-key menu [customize-changed]
+ '(menu-item "New Options..." customize-changed
+ :help "Options and faces added or changed in recent Emacs
versions"))
(bindings--define-key menu [customize-saved]
'(menu-item "Saved Options" customize-saved
:help "Customize previously saved options"))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 9ad843c..1d25b14 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -136,7 +136,7 @@ displayed."
(show-window (get-buffer-window mh-show-buffer))
(display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
(if (not (eq (next-window (minibuffer-window)) (selected-window)))
- (delete-other-windows)) ; force ourself to the top window
+ (delete-other-windows)) ; force ourselves to the top window
(mh-in-show-buffer (mh-show-buffer)
(setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
(if (and show-window
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 03cc70c..aacb8ab 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2116,16 +2116,19 @@ variables.")
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
+ (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.
- (when (innermost-minibuffer-p)
- (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/dictionary-connection.el
b/lisp/net/dictionary-connection.el
index d88c0b4..8312574 100644
--- a/lisp/net/dictionary-connection.el
+++ b/lisp/net/dictionary-connection.el
@@ -1,34 +1,36 @@
;;; dictionary-connection.el --- TCP-based client connection for dictionary
-*- lexical-binding:t -*-
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
;; Keywords: network
-;; This file is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; dictionary-connection allows to handle TCP-based connections in
-;; client mode where text-based information are exchanged. There is
+;; client mode where text-based information is exchanged. There is
;; special support for handling CR LF (and the usual CR LF . CR LF
-;; terminater).
+;; terminator).
;;; Code:
(defsubst dictionary-connection-p (connection)
- "Returns non-nil if CONNECTION is a connection object."
+ "Return non-nil if CONNECTION is a connection object."
(get connection 'connection))
(defsubst dictionary-connection-read-point (connection)
@@ -66,7 +68,7 @@
(defun dictionary-connection-open (server port)
"Open a connection to SERVER at PORT.
-A data structure identifing the connection is returned"
+A data structure identifying the connection is returned"
(let ((process-buffer (generate-new-buffer (format " connection to %s:%s"
server
@@ -147,8 +149,7 @@ nil: argument is no connection object
(defun dictionary-connection-read-to-point (connection)
"Read from CONNECTION until an end of entry is encountered.
-End of entry is a decimal point found on a line by itself.
-"
+End of entry is a decimal point found on a line by itself."
(dictionary-connection-read connection "\015?\012[.]\015?\012"))
(provide 'dictionary-connection)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index f873342..c6af4e6 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -1,22 +1,24 @@
;;; dictionary.el --- Client for rfc2229 dictionary servers -*-
lexical-binding:t -*-
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
;; Keywords: interface, dictionary
-;; This file is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,7 +48,7 @@
(defun dictionary-set-server-var (name value)
"Customize helper for setting variable NAME to VALUE.
The helper is used by customize to check for an active connection
-when setting a variable. The user has then the choice to close
+when setting a variable. The user has then the choice to close
the existing connection."
(if (and (boundp 'dictionary-connection)
dictionary-connection
@@ -73,8 +75,7 @@ You can specify here:
- Automatic: First try localhost, then dict.org after confirmation
- localhost: Only use localhost
- dict.org: Only use dict.org
-- User-defined: You can specify your own server here
-"
+- User-defined: You can specify your own server here"
:group 'dictionary
:set 'dictionary-set-server-var
:type '(choice (const :tag "Automatic" nil)
@@ -86,7 +87,7 @@ You can specify here:
(defcustom dictionary-port
2628
"The port of the dictionary server.
- This port is propably always 2628 so there should be no need to modify it."
+This port is propably always 2628 so there should be no need to modify it."
:group 'dictionary
:set 'dictionary-set-server-var
:type 'number
@@ -102,8 +103,8 @@ You can specify here:
(defcustom dictionary-default-dictionary
"*"
"The dictionary which is used for searching definitions and matching.
- * and ! have a special meaning, * search all dictionaries, ! search until
- one dictionary yields matches."
+* and ! have a special meaning, * search all dictionaries, ! search until
+one dictionary yields matches."
:group 'dictionary
:type 'string
:version "28.1")
@@ -126,9 +127,9 @@ by the choice value:
The found word exactly matches the searched word.
-- Similiar sounding
+- Similar sounding
- The found word sounds similiar to the searched word. For this match type
+ The found word sounds similar to the searched word. For this match type
the soundex algorithm defined by Donald E. Knuth is used. It will only
works with english words and the algorithm is not very reliable (i.e.,
the soundex algorithm is quite simple).
@@ -144,11 +145,10 @@ by the choice value:
- User choice
Here you can enter any matching algorithm supported by your
- dictionary server.
-"
+ dictionary server."
:group 'dictionary
:type '(choice (const :tag "Exact match" "exact")
- (const :tag "Similiar sounding" "soundex")
+ (const :tag "Similar sounding" "soundex")
(const :tag "Levenshtein distance one" "lev")
(string :tag "User choice"))
:version "28.1")
@@ -160,6 +160,18 @@ by the choice value:
:type 'boolean
:version "28.1")
+(defcustom dictionary-link-dictionary
+ "*"
+ "The dictionary which is used in links.
+* means to create links that search all dictionaries,
+nil means to create links that search only in the same dictionary
+where the current word was found."
+ :group 'dictionary
+ :type '(choice (const :tag "Link to all dictionaries" "*")
+ (const :tag "Link only to the same dictionary" nil)
+ (string :tag "User choice"))
+ :version "28.1")
+
(defcustom dictionary-mode-hook
nil
"Hook run in dictionary mode buffers."
@@ -167,6 +179,13 @@ by the choice value:
:type 'hook
:version "28.1")
+(defcustom dictionary-post-buffer-hook
+ nil
+ "Hook run at the end of every update of the dictionary buffer."
+ :group 'dictionary
+ :type 'hook
+ :version "28.1")
+
(defcustom dictionary-use-http-proxy
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
@@ -177,7 +196,7 @@ by the choice value:
(defcustom dictionary-proxy-server
"proxy"
- "The name of the HTTP proxy to use when dictionary-use-http-proxy is set."
+ "The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:type 'string
@@ -185,7 +204,7 @@ by the choice value:
(defcustom dictionary-proxy-port
3128
- "The port of the proxy server, used only when dictionary-use-http-proxy is
set."
+ "The port of the proxy server, used only when `dictionary-use-http-proxy' is
set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:type 'number
@@ -200,14 +219,14 @@ by the choice value:
(defcustom dictionary-description-open-delimiter
""
- "The delimiter to display in front of the dictionaries description"
+ "The delimiter to display in front of the dictionaries description."
:group 'dictionary
:type 'string
:version "28.1")
(defcustom dictionary-description-close-delimiter
""
- "The delimiter to display after of the dictionaries description"
+ "The delimiter to display after of the dictionaries description."
:group 'dictionary
:type 'string
:version "28.1")
@@ -283,27 +302,27 @@ is utf-8"
(defvar dictionary-window-configuration
nil
- "The window configuration to be restored upon closing the buffer")
+ "The window configuration to be restored upon closing the buffer.")
(defvar dictionary-selected-window
nil
- "The currently selected window")
+ "The currently selected window.")
(defvar dictionary-position-stack
nil
- "The history buffer for point and window position")
+ "The history buffer for point and window position.")
(defvar dictionary-data-stack
nil
- "The history buffer for functions and arguments")
+ "The history buffer for functions and arguments.")
(defvar dictionary-positions
nil
- "The current positions")
+ "The current positions.")
(defvar dictionary-current-data
nil
- "The item that will be placed on stack next time")
+ "The item that will be placed on stack next time.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global variables
@@ -323,18 +342,19 @@ is utf-8"
(define-key map "l" 'dictionary-previous)
(define-key map "n" 'forward-button)
(define-key map "p" 'backward-button)
- (define-key map " " 'scroll-up)
- (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
+ (define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
+ (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command)
map)
"Keymap for the dictionary mode.")
(defvar dictionary-connection
nil
- "The current network connection")
+ "The current network connection.")
(defvar dictionary-instances
0
- "The number of open dictionary buffers")
+ "The number of open dictionary buffers.")
(defvar dictionary-marker
nil
@@ -344,11 +364,11 @@ is utf-8"
(condition-case nil
(x-display-color-p)
(error nil))
- "Determines if the Emacs has support to display color")
+ "Determines if the Emacs has support to display color.")
(defvar dictionary-word-history
'()
- "History list of searched word")
+ "History list of searched word.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic function providing startup actions
@@ -356,25 +376,25 @@ is utf-8"
;;;###autoload
(defun dictionary-mode ()
+ ;; FIXME: Use define-derived-mode.
"Mode for searching a dictionary.
This is a mode for searching a dictionary server implementing the
protocol defined in RFC 2229.
This is a quick reference to this mode describing the default key bindings:
+\\<dictionary-mode-map>
+* \\[dictionary-close] close the dictionary buffer
+* \\[dictionary-help] display this help information
+* \\[dictionary-search] ask for a new word to search
+* \\[dictionary-lookup-definition] search the word at point
+* \\[forward-button] or TAB place point to the next link
+* \\[backward-button] or S-TAB place point to the prev link
-* q close the dictionary buffer
-* h display this help information
-* s ask for a new word to search
-* d search the word at point
-* n or Tab place point to the next link
-* p or S-Tab place point to the prev link
-
-* m ask for a pattern and list all matching words.
-* D select the default dictionary
-* M select the default search strategy
+* \\[dictionary-match-words] ask for a pattern and list all matching words.
+* \\[dictionary-select-dictionary] select the default dictionary
+* \\[dictionary-select-strategy] select the default search strategy
-* Return or Button2 visit that link
-"
+* RET or <mouse-2> visit that link"
(unless (eq major-mode 'dictionary-mode)
(cl-incf dictionary-instances))
@@ -399,7 +419,7 @@ This is a quick reference to this mode describing the
default key bindings:
;;;###autoload
(defun dictionary ()
- "Create a new dictonary buffer and install dictionary-mode."
+ "Create a new dictionary buffer and install `dictionary-mode'."
(interactive)
(let ((buffer (or (and dictionary-use-single-buffer
(get-buffer "*Dictionary*"))
@@ -498,13 +518,13 @@ The connection takes the proxy setting in customization
group
(dictionary-open-server server)
(error
(if (y-or-n-p
- (format "Failed to open server %s, continue with dict.org?"
+ (format "Failed to open server %s, continue with dict.org? "
server))
(dictionary-open-server "dict.org")
(error "Failed automatic server selection, please customize
dictionary-server"))))))))
(defun dictionary-mode-p ()
- "Return non-nil if current buffer has dictionary-mode."
+ "Return non-nil if current buffer has `dictionary-mode'."
(eq major-mode 'dictionary-mode))
(defun dictionary-ensure-buffer ()
@@ -535,7 +555,7 @@ The connection takes the proxy setting in customization
group
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-send-command (string)
- "Send the command `string' to the network connection."
+ "Send the command STRING to the network connection."
(dictionary-check-connection)
;;;; #####
(dictionary-connection-send-crlf dictionary-connection string))
@@ -548,7 +568,7 @@ The connection takes the proxy setting in customization
group
answer)))
(defun dictionary-split-string (string)
- "Split STRING constiting of space-separated words into elements.
+ "Split STRING consisting of space-separated words into elements.
This function knows about the special meaning of quotes (\")"
(let ((list))
(while (and string (> (length string) 0))
@@ -566,7 +586,7 @@ This function knows about the special meaning of quotes
(\")"
(nreverse list)))
(defun dictionary-read-reply-and-split ()
- "Reads the reply, splits it into words and returns it."
+ "Read the reply, split it into words and return it."
(let ((answer (make-symbol "reply-data"))
(reply (dictionary-read-reply)))
(let ((reply-list (dictionary-split-string reply)))
@@ -589,7 +609,7 @@ The answer is delimited by a decimal point (.) on a line by
itself."
answer))
(defun dictionary-check-reply (reply code)
- "Extract the reply code from REPLY and checks against CODE."
+ "Extract the reply code from REPLY and check against CODE."
(let ((number (dictionary-reply-code reply)))
(and (numberp number)
(= number code))))
@@ -623,7 +643,7 @@ The answer is delimited by a decimal point (.) on a line by
itself."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-check-initial-reply ()
- "Reads the first reply from server and checks it."
+ "Read the first reply from server and check it."
(let ((reply (dictionary-read-reply-and-split)))
(unless (dictionary-check-reply reply 220)
(dictionary-connection-close dictionary-connection)
@@ -631,9 +651,9 @@ The answer is delimited by a decimal point (.) on a line by
itself."
;; Store the current state
(defun dictionary-store-state (function data)
- "Stores the current state of operation for later restore.
-The current state consist of a tuple of FUNCTION and DATA. This
-is basically an implementation of a history to return to a
+ "Store the current state of operation for later restore.
+The current state consist of a tuple of FUNCTION and DATA.
+This is basically an implementation of a history to return to a
previous state."
(if dictionary-current-data
(progn
@@ -645,7 +665,7 @@ previous state."
(cons function data)))
(defun dictionary-store-positions ()
- "Stores the current positions for later restore."
+ "Store the current positions for later restore."
(setq dictionary-positions (cons (point) (window-start))))
@@ -664,7 +684,7 @@ previous state."
;; The normal search
(defun dictionary-new-search (args &optional all)
- "Saves the current state and starts a new search based on ARGS.
+ "Save the current state and start a new search based on ARGS.
The parameter ARGS is a cons cell where car is the word to search
and cdr is the dictionary where to search the word in."
(interactive)
@@ -680,15 +700,14 @@ and cdr is the dictionary where to search the word in."
(list word dictionary
'dictionary-display-search-result))))
(defun dictionary-new-search-internal (word dictionary function)
- "Starts a new search for WORD in DICTIONARY after preparing the buffer.
-FUNCTION is the callback which is called for each search result.
-"
+ "Start a new search for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result."
(dictionary-pre-buffer)
(dictionary-do-search word dictionary function))
(defun dictionary-do-search (word dictionary function &optional nomatching)
- "Searches WORD in DICTIONARY and calls FUNCTION for each result.
-The parameter NOMATCHING controls whether to suppress the display
+ "Search for WORD in DICTIONARY and call FUNCTION for each result.
+Optional argument NOMATCHING controls whether to suppress the display
of matching words."
(message "Searching for %s in %s" word dictionary)
@@ -712,7 +731,7 @@ of matching words."
'dictionary-display-only-match-result)
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
- (error "Dictionary \"%s\" is unknown, please select an existing one."
+ (error "Dictionary \"%s\" is unknown, please select an existing one"
dictionary)
(unless (dictionary-check-reply reply 150)
(error "Unknown server answer: %s" (dictionary-reply reply)))
@@ -773,10 +792,11 @@ of matching words."
(goto-char dictionary-marker)
(set-buffer-modified-p nil)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (run-hooks 'dictionary-post-buffer-hook))
(defun dictionary-display-search-result (reply)
- "This function starts displaying the result in REPLY."
+ "Start displaying the result in REPLY."
(let ((number (nth 1 (dictionary-reply-list reply))))
(insert number (if (equal number "1")
@@ -810,8 +830,7 @@ The DICTIONARY is only used for decoding the bytes to
display the DESCRIPTION."
(defun dictionary-display-word-definition (reply word dictionary)
"Insert the definition in REPLY for the current WORD from DICTIONARY.
It will replace links which are found in the REPLY and replace
-them with buttons to perform a a new search.
-"
+them with buttons to perform a a new search."
(let ((start (point)))
(insert (dictionary-decode-charset reply dictionary))
(insert "\n\n")
@@ -844,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
(setq word (replace-match " " t t word)))
(while (string-match "[*\"]" word)
(setq word (replace-match "" t t word)))
+ (when dictionary-link-dictionary
+ (setq dictionary dictionary-link-dictionary))
(unless (equal word displayed-word)
(make-button start end :type 'dictionary-link
@@ -873,7 +894,7 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
(unless (dictionary-check-reply reply 110)
(error "Unknown server answer: %s"
(dictionary-reply reply)))
- (dictionary-display-dictionarys))))
+ (dictionary-display-dictionaries))))
(defun dictionary-simple-split-string (string &optional pattern)
"Return a list of substrings of STRING which are separated by PATTERN.
@@ -888,7 +909,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
start (match-end 0)))
(nreverse (cons (substring string start) parts))))
-(defun dictionary-display-dictionarys ()
+(defun dictionary-display-dictionaries ()
"Handle the display of all dictionaries existing on the server."
(dictionary-pre-buffer)
(insert "Please select your default dictionary:\n\n")
@@ -931,7 +952,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(message "Dictionary %s has been selected" dictionary))))
(defun dictionary-special-dictionary (name)
- "Checks whether the special * or ! dictionary are seen in NAME."
+ "Check whether the special * or ! dictionary are seen in NAME."
(or (equal name "*")
(equal name "!")))
@@ -1011,7 +1032,7 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
(insert "\n")))))
(defun dictionary-set-strategy (strategy &rest ignored)
- "Select this STRATEGY as new default"
+ "Select this STRATEGY as new default."
(setq dictionary-default-strategy strategy)
(dictionary-restore-state)
(message "Strategy %s has been selected" strategy))
@@ -1119,9 +1140,11 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
;; - if region is active returns its contents
;; - otherwise return the word near the point
(defun dictionary-search-default ()
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning) (region-end))
- (current-word t)))
+ (cond
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ ((car (get-char-property (point) 'data)))
+ (t (current-word t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User callable commands
@@ -1148,7 +1171,7 @@ allows editing it."
;; if called by pressing the button
(unless word
(setq word (read-string "Search word: " nil 'dictionary-word-history)))
- ;; just in case non-interactivly called
+ ;; just in case non-interactively called
(unless dictionary
(setq dictionary dictionary-default-dictionary))
(dictionary-new-search (cons word dictionary)))
@@ -1226,15 +1249,15 @@ allows editing it."
;;; Tooltip support
-;; Add a mode indicater named "Dict"
+;; Add a mode indicator named "Dict"
(defvar dictionary-tooltip-mode
nil
- "Indicates wheather the dictionary tooltip mode is active.")
+ "Indicates whether the dictionary tooltip mode is active.")
(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
(defcustom dictionary-tooltip-dictionary
nil
- "This dictionary to lookup words for tooltips"
+ "This dictionary to lookup words for tooltips."
:group 'dictionary
:type '(choice (const :tag "None" nil) string)
:version "28.1")
@@ -1296,8 +1319,7 @@ It is normally internally called with 1 to enable support
for the
tooltip mode. The hook function will check the value of the
variable dictionary-tooltip-mode to decide if some action must be
taken. When disabling the tooltip mode the value of this variable
-will be set to nil.
-"
+will be set to nil."
(interactive)
(tooltip-mode on)
(if on
@@ -1309,10 +1331,8 @@ will be set to nil.
"Display tooltips for the current word.
This function can be used to enable or disable the tooltip mode
-for the current buffer (based on ARG). If global-tooltip-mode is
-active it will overwrite that mode for the current buffer.
-"
-
+for the current buffer (based on ARG). If global-tooltip-mode is
+active it will overwrite that mode for the current buffer."
(interactive "P")
(require 'tooltip)
(let ((on (if arg
@@ -1335,8 +1355,7 @@ Internally it provides a default for the
dictionary-tooltip-mode.
It can be overwritten for each buffer using dictionary-tooltip-mode.
Note: (global-dictionary-tooltip-mode 0) will not disable the mode
-any buffer where (dictionary-tooltip-mode 1) has been called.
-"
+any buffer where (dictionary-tooltip-mode 1) has been called."
(interactive "P")
(require 'tooltip)
(let ((on (if arg (> (prefix-numeric-value arg) 0)
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index 66a684d..b07016c 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -108,7 +108,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting
to
(defun eudc-macos-contacts-set-server (dummy)
"Set the EUDC server to macOS Contacts app.
The server in DUMMY is not actually used, since this backend
-always and implicitly connetcs to an instance of the Contacts app
+always and implicitly connects to an instance of the Contacts app
running on the local host."
(interactive)
(eudc-set-server dummy 'macos-contacts)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 55f5242..e30cc78 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/ldap.el b/lisp/net/ldap.el
index 0476835..7997bf3 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
-;;; ldap.el --- client interface to LDAP for Emacs
+;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -418,12 +418,12 @@ RFC2798 Section 9.1.1")
(encode-coding-string str ldap-coding-system))
(defun ldap-decode-address (str)
- (mapconcat 'ldap-decode-string
+ (mapconcat #'ldap-decode-string
(split-string str "\\$")
"\n"))
(defun ldap-encode-address (str)
- (mapconcat 'ldap-encode-string
+ (mapconcat #'ldap-encode-string
(split-string str "\n")
"$"))
@@ -601,7 +601,7 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result proc)
+ arglist dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
@@ -671,7 +671,7 @@ an alist of attribute/value pairs."
" bind distinguished name (binddn)"))
(error "Failed ldapsearch invocation: %s \"%s\""
ldap-ldapsearch-prog
- (mapconcat 'identity proc-args "\" \""))))))
+ (mapconcat #'identity proc-args "\" \""))))))
(apply #'call-process ldap-ldapsearch-prog
;; Ignore stderr, which can corrupt results
nil (list buf nil) nil
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 455673b..3097c9a 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -332,7 +332,7 @@ whose car is a symbol, it is `eval'uated to yield the
validity. If it
is a string or list of strings, it represents a shell command to run
to return a true or false shell value for the validity.
-The last matching entry in this structure takes presedence over
+The last matching entry in this structure takes precedence over
preceding entries.")
(put 'mailcap-mime-data 'risky-local-variable t)
@@ -842,11 +842,11 @@ If NO-DECODE is non-nil, don't decode STRING."
;; ~/.mailcap file, then we filter out the system entries
;; and see whether we have anything left.
(when mailcap-prefer-mailcap-viewers
- (when-let ((user-entry
- (seq-find (lambda (elem)
- (eq (cdr (assq 'source elem)) 'user))
- passed)))
- (setq passed (list user-entry))))
+ (when-let ((user-entries
+ (seq-filter (lambda (elem)
+ (eq (cdr (assq 'source elem)) 'user))
+ passed)))
+ (setq passed user-entries)))
(setq viewer (car passed))))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 08edb44..024d118 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,4 +1,4 @@
-;;; mairix.el --- Mairix interface for Emacs
+;;; mairix.el --- Mairix interface for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -83,55 +83,46 @@
(defcustom mairix-file-path "~/"
"Path where output files produced by Mairix should be stored."
- :type 'directory
- :group 'mairix)
+ :type 'directory)
(defcustom mairix-search-file "mairixsearch.mbox"
"Name of the default file for storing the searches.
Note that this will be prefixed by `mairix-file-path'."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-command "mairix"
"Command for calling mairix.
You can add further options here if you want to, but better use
`mairix-update-options' instead."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-output-buffer "*mairix output*"
"Name of the buffer for the output of the mairix binary."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-customize-query-buffer "*mairix query*"
"Name of the buffer for customizing a search query."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-saved-searches-buffer "*mairix searches*"
"Name of the buffer for displaying saved searches."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
The default is \"-F\" and \"-Q\" for making updates faster. You
should call mairix without these options from time to
time (e.g. via cron job)."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-search-options '("-Q")
"Options when calling mairix for searching.
The default is \"-Q\" for making searching faster."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-synchronous-update nil
"Defines if Emacs should wait for the mairix database update."
- :type 'boolean
- :group 'mairix)
+ :type 'boolean)
(defcustom mairix-saved-searches nil
"Saved mairix searches.
@@ -144,8 +135,7 @@ threads (nil or t). Note that the file will be prefixed by
(choice :tag "File"
(const :tag "default")
file)
- (boolean :tag "Threads")))
- :group 'mairix)
+ (boolean :tag "Threads"))))
(defcustom mairix-mail-program 'rmail
"Mail program used to display search results.
@@ -153,8 +143,7 @@ Currently RMail, Gnus (mbox), and VM are supported. If you
use Gnus
with maildir, use nnmairix.el instead."
:type '(choice (const :tag "RMail" rmail)
(const :tag "Gnus mbox" gnus)
- (const :tag "VM" vm))
- :group 'mairix)
+ (const :tag "VM" vm)))
(defcustom mairix-display-functions
'((rmail mairix-rmail-display)
@@ -166,8 +155,7 @@ This is an alist where each entry consists of a symbol from
displaying the search results. The function will be called with
the mailbox file produced by mairix as the single argument."
:type '(repeat (list (symbol :tag "Mail program")
- (function)))
- :group 'mairix)
+ (function))))
(defcustom mairix-get-mail-header-functions
'((rmail mairix-rmail-fetch-field)
@@ -184,15 +172,13 @@ won't work."
:type '(repeat (list (symbol :tag "Mail program")
(choice :tag "Header function"
(const :tag "none")
- function)))
- :group 'mairix)
+ function))))
(defcustom mairix-widget-select-window-function
(lambda () (select-window (get-largest-window)))
"Function for selecting the window for customizing the mairix query.
The default chooses the largest window in the current frame."
- :type 'function
- :group 'mairix)
+ :type 'function)
;; Other variables
@@ -466,18 +452,18 @@ MVALUES may contain values from current article."
;; generate Buttons
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-send-query mairix-widgets))
"Send Query")
(widget-insert " ")
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-save-search mairix-widgets))
"Save search")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(kill-buffer mairix-customize-query-buffer))
"Cancel")
(use-local-map widget-keymap)
@@ -502,7 +488,7 @@ Mairix will be called asynchronously unless
(cdr commandsplit)
mairix-update-options))
(setq args (append args mairix-update-options)))
- (apply 'call-process args))
+ (apply #'call-process args))
(progn
(message "Updating mairix database...")
(setq args (append (list "mairixupdate" (get-buffer-create
mairix-output-buffer)
@@ -511,8 +497,8 @@ Mairix will be called asynchronously unless
(setq args (append args (cdr commandsplit) mairix-update-options))
(setq args (append args mairix-update-options)))
(set-process-sentinel
- (apply 'start-process args)
- 'mairix-sentinel-mairix-update-finished)))))
+ (apply #'start-process args)
+ #'mairix-sentinel-mairix-update-finished)))))
;;;; Helper functions
@@ -557,7 +543,7 @@ whole threads. Function returns t if messages were found."
mairix-file-path))
file))
(setq rval
- (apply 'call-process
+ (apply #'call-process
(append args (list "-o" file) query)))
(if (zerop rval)
(with-current-buffer mairix-output-buffer
@@ -582,7 +568,7 @@ whole threads. Function returns t if messages were found."
(setq header (replace-match "," t t header)))
header))
-(defun mairix-sentinel-mairix-update-finished (proc status)
+(defun mairix-sentinel-mairix-update-finished (_proc status)
"Sentinel for mairix update process PROC with STATUS."
(if (equal status "finished\n")
(message "Updating mairix database... done")
@@ -642,51 +628,50 @@ See %s for details" mairix-output-buffer)))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
;; return query string
- (mapconcat 'identity query " ")))
+ (mapconcat #'identity query " ")))
(defun mairix-widget-create-query (&optional values)
"Create widgets for creating mairix queries.
Fill in VALUES if based on an article."
- (let (allwidgets)
- (when (get-buffer mairix-customize-query-buffer)
- (kill-buffer mairix-customize-query-buffer))
- (switch-to-buffer mairix-customize-query-buffer)
- (kill-all-local-variables)
- (erase-buffer)
- (widget-insert
- "Specify your query for Mairix using check boxes for activating
fields.\n\n")
- (widget-insert
- (concat "Use ~word to match messages "
- (propertize "not" 'face 'italic)
- " containing the word)\n"
- " substring= to match words containing the substring\n"
- " substring=N to match words containing the substring,
allowing\n"
- " up to N errors(missing/extra/different
letters)\n"
- " ^substring= to match the substring at the beginning of a
word.\n"))
- (widget-insert
- (format-message
- "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
- (setq mairix-widgets (mairix-widget-build-editable-fields values))
- (when (member 'flags mairix-widget-other)
- (widget-insert "\nFlags:\n Seen: ")
- (mairix-widget-add "seen"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Replied: ")
- (mairix-widget-add "replied"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Ticked: ")
- (mairix-widget-add "flagged"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore")))
- (when (member 'threads mairix-widget-other)
- (widget-insert "\n")
- (mairix-widget-add "Threads" 'checkbox nil))
- (widget-insert " Show full threads\n\n")))
+ (when (get-buffer mairix-customize-query-buffer)
+ (kill-buffer mairix-customize-query-buffer))
+ (switch-to-buffer mairix-customize-query-buffer)
+ (kill-all-local-variables)
+ (erase-buffer)
+ (widget-insert
+ "Specify your query for Mairix using check boxes for activating
fields.\n\n")
+ (widget-insert
+ (concat "Use ~word to match messages "
+ (propertize "not" 'face 'italic)
+ " containing the word)\n"
+ " substring= to match words containing the substring\n"
+ " substring=N to match words containing the substring,
allowing\n"
+ " up to N errors(missing/extra/different letters)\n"
+ " ^substring= to match the substring at the beginning of a
word.\n"))
+ (widget-insert
+ (format-message
+ "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
+ (setq mairix-widgets (mairix-widget-build-editable-fields values))
+ (when (member 'flags mairix-widget-other)
+ (widget-insert "\nFlags:\n Seen: ")
+ (mairix-widget-add "seen"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Replied: ")
+ (mairix-widget-add "replied"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Ticked: ")
+ (mairix-widget-add "flagged"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore")))
+ (when (member 'threads mairix-widget-other)
+ (widget-insert "\n")
+ (mairix-widget-add "Threads" 'checkbox nil))
+ (widget-insert " Show full threads\n\n"))
(defun mairix-widget-build-editable-fields (values)
"Build editable field widgets in `nnmairix-widget-fields-list'.
@@ -703,7 +688,7 @@ VALUES may contain values for editable fields from current
article."
(concat "c" field)
(widget-create 'checkbox
:tag field
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(mairix-widget-toggle-activate widget))
nil)))
(list
@@ -727,7 +712,7 @@ VALUES may contain values for editable fields from current
article."
"Add a widget NAME with optional ARGS."
(push
(list name
- (apply 'widget-create args))
+ (apply #'widget-create args))
mairix-widgets))
(defun mairix-widget-toggle-activate (widget)
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index cf55f66..a2d4d89 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -1626,7 +1626,7 @@ Return t if a new feed was activated, nil otherwise."
(interactive
(list (let ((completion-ignore-case t))
(completing-read
- "Jump to feed: "
+ "Jump to feed/group: "
(append '("new" "obsolete" "immortal" "all")
(mapcar #'car (append newsticker-url-list
newsticker-url-list-defaults)))
@@ -1852,28 +1852,34 @@ of the shift. If MOVE-GROUP is nil the currently
selected feed
`newsticker--treeview-current-feed' is shifted, if it is t then
the current feed's parent group is shifted.."
(let* ((cur-feed newsticker--treeview-current-feed)
- (thing (if move-group
- (newsticker--group-find-parent-group cur-feed)
+ (thing (if (and move-group
+ (not (newsticker--group-get-group cur-feed)))
+ (car (newsticker--group-find-parent-group cur-feed))
cur-feed))
(parent-group (newsticker--group-find-parent-group
- (if move-group (car thing) thing))))
+ ;;(if move-group (car thing) thing)
+ thing)))
(unless parent-group
(error "Group not found!"))
(let* ((siblings (cdr parent-group))
- (pos (cl-position thing siblings :test 'equal))
+ (pos (cl-position thing siblings :test
+ (lambda (o1 o2)
+ (equal (if (listp o1) (car o1) o1)
+ (if (listp o2) (car o2) o2)))))
(tpos (+ pos delta ))
(new-pos (max 0 (min (length siblings) tpos)))
(beg (cl-subseq siblings 0 (min pos new-pos)))
(end (cl-subseq siblings (+ 1 (max pos new-pos))))
(p (elt siblings new-pos)))
(when (not (= pos new-pos))
- (setcdr parent-group
- (cl-concatenate 'list
- beg
- (if (> delta 0)
- (list p thing)
- (list thing p))
- end))
+ (let ((th (or (newsticker--group-get-group thing) thing)))
+ (setcdr parent-group
+ (cl-concatenate 'list
+ beg
+ (if (> delta 0)
+ (list p th)
+ (list th p))
+ end)))
(newsticker--treeview-tree-update)
(newsticker-treeview-update)
(newsticker-treeview-jump cur-feed)))))
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/snmp-mode.el b/lisp/net/snmp-mode.el
index 983e6d9..ae878ef 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -1,4 +1,4 @@
-;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode
+;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998, 2001-2021 Free Software Foundation, Inc.
@@ -69,16 +69,6 @@
;; Once the template is done, you can use C-cC-f and C-cC-b to move back
;; and forth between the Tempo sequence points to fill in the rest of
;; the information.
-;;
-;; Font Lock
-;; ------------
-;;
-;; If you want font-lock in your MIB buffers, add this:
-;;
-;; (add-hook 'snmp-common-mode-hook 'turn-on-font-lock)
-;;
-;; Enabling global-font-lock-mode is also sufficient.
-;;
;;; Code:
@@ -101,42 +91,35 @@
(defcustom snmp-special-indent t
"If non-nil, use a simple heuristic to try to guess the right indentation.
If nil, then no special indentation is attempted."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-indent-level 4
"Indentation level for SNMP MIBs."
- :type 'integer
- :group 'snmp)
+ :type 'integer)
(defcustom snmp-tab-always-indent nil
"Non-nil means TAB should always reindent the current line.
A value of nil means reindent if point is within the initial line indentation;
otherwise insert a TAB."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-completion-ignore-case t
"Non-nil means that case differences are ignored during completion.
A value of nil means that case is significant.
This is used during Tempo template completion."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-common-mode-hook nil
"Hook(s) evaluated when a buffer enters either SNMP or SNMPv2 mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defcustom snmp-mode-hook nil
"Hook(s) evaluated when a buffer enters SNMP mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defcustom snmpv2-mode-hook nil
"Hook(s) evaluated when a buffer enters SNMPv2 mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defvar snmp-tempo-tags nil
"Tempo tags for SNMP mode.")
@@ -291,7 +274,7 @@ This is used during Tempo template completion."
;; Set up the stuff that's common between snmp-mode and snmpv2-mode
;;
-(defun snmp-common-mode (name mode abbrev font-keywords imenu-index tempo-tags)
+(defun snmp-common-mode (name mode abbrev font-keywords imenu-index
mode-tempo-tags)
(kill-all-local-variables)
;; Become the current major mode
@@ -326,7 +309,7 @@ This is used during Tempo template completion."
(setq-local imenu-create-index-function imenu-index)
;; Tempo
- (tempo-use-tag-list tempo-tags)
+ (tempo-use-tag-list mode-tempo-tags)
(setq-local tempo-match-finder "\\b\\(.+\\)\\=")
(setq-local tempo-interactive t)
@@ -338,6 +321,7 @@ This is used during Tempo template completion."
;;
;;;###autoload
(defun snmp-mode ()
+ ;; FIXME: Use define-derived-mode.
"Major mode for editing SNMP MIBs.
Expression and list commands understand all C brackets.
Tab indents for C code.
@@ -370,6 +354,7 @@ Turning on snmp-mode runs the hooks in
`snmp-common-mode-hook', then
;;;###autoload
(defun snmpv2-mode ()
+ ;; FIXME: Use define-derived-mode.
"Major mode for editing SNMPv2 MIBs.
Expression and list commands understand all C brackets.
Tab indents for C code.
@@ -474,13 +459,11 @@ lines for the purposes of this function."
(index-table-alist '())
(index-trap-alist '())
(case-fold-search nil) ; keywords must be uppercase
- prev-pos token end)
+ token end)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
;; Search for a useful MIB item (that's not in a comment)
(save-match-data
(while (re-search-forward snmp-clause-regexp nil t)
- (imenu-progress-message prev-pos)
(setq
end (match-end 0)
token (cons (match-string 1)
@@ -498,7 +481,6 @@ lines for the purposes of this function."
(push token index-tc-alist)))
(goto-char end)))
;; Create the menu
- (imenu-progress-message prev-pos 100)
(setq index-alist (nreverse index-alist))
(and index-tc-alist
(push (cons "Textual Conventions" (nreverse index-tc-alist))
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..6935955 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
@@ -1925,7 +1928,7 @@ If ARGUMENT is non-nil, use it as argument for
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
- ;; capabilities migh have changed.
+ ;; capabilities might have changed.
(unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
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/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 0602943..1bc905c 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -546,7 +546,7 @@ Many aspects this mode can be customized using
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
(setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
- ;; When starting a new file, insert the XML declaraction.
+ ;; When starting a new file, insert the XML declaration.
(when (and nxml-auto-insert-xml-declaration-flag
(zerop (buffer-size)))
(nxml-insert-xml-declaration)))
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/ol-w3m.el b/lisp/org/ol-w3m.el
index f1f3afd..ebb11ce 100644
--- a/lisp/org/ol-w3m.el
+++ b/lisp/org/ol-w3m.el
@@ -7,13 +7,13 @@
;; Homepage: https://orgmode.org
;;
;; This file is part of GNU Emacs.
-;;
-;; This program is free software: you can redistribute it and/or modify
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
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/org/org-refile.el b/lisp/org/org-refile.el
index 1e0c339..8b42f81 100644
--- a/lisp/org/org-refile.el
+++ b/lisp/org/org-refile.el
@@ -7,18 +7,18 @@
;;
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
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/pcomplete.el b/lisp/pcomplete.el
index 7effb27..b648ecf 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -135,11 +135,8 @@
"A regexp of names to be disregarded during directory completion."
:type '(choice regexp (const :tag "None" nil)))
-(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
- ;; FIXME: the doc mentions file-name completion, but the code
- ;; seems to apply it to all completions.
- "If non-nil, ignore case when doing filename completion."
- :type 'boolean)
+(define-obsolete-variable-alias 'pcomplete-ignore-case 'completion-ignore-case
+ "28.1")
(defcustom pcomplete-autolist nil
"If non-nil, automatically list possibilities on partial completion.
@@ -472,7 +469,7 @@ Same as `pcomplete' but using the standard completion UI."
(not (member
(funcall norm-func (directory-file-name f))
seen)))))))
- (when pcomplete-ignore-case
+ (when completion-ignore-case
(setq table (completion-table-case-fold table)))
(list beg (point) table
:predicate pred
@@ -865,7 +862,7 @@ this is `comint-dynamic-complete-functions'."
(sort comps pcomplete-compare-entry-function)))
,@(cdr (completion-file-name-table s p a)))
(let ((completion-ignored-extensions nil)
- (completion-ignore-case pcomplete-ignore-case))
+ (completion-ignore-case completion-ignore-case))
(completion-table-with-predicate
#'comint-completion-file-name-table pred 'strict s p a))))))
@@ -1116,7 +1113,7 @@ Typing SPC flushes the help buffer."
"Insert a completion entry at point.
Returns non-nil if a space was appended at the end."
(let ((here (point)))
- (if (not pcomplete-ignore-case)
+ (if (not completion-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
(comint-quote-filename
@@ -1194,7 +1191,7 @@ Returns `partial' if completed as far as possible with
the matches.
Returns `listed' if a completion listing was shown.
See also `pcomplete-filename'."
- (let* ((completion-ignore-case pcomplete-ignore-case)
+ (let* ((completion-ignore-case completion-ignore-case)
(completions (all-completions stub candidates))
(entry (try-completion stub candidates))
result)
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 05e61df..3630c19 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,4 +1,4 @@
-;;; 5x5.el --- simple little puzzle game
+;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -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 ()
@@ -289,7 +290,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-draw-grid-end ()
"Draw the top/bottom of the grid."
(insert "+")
- (dotimes (x 5x5-grid-size)
+ (dotimes (_ 5x5-grid-size)
(insert "-" (make-string 5x5-x-scale ?-)))
(insert "-+ "))
@@ -297,11 +298,11 @@ Quit current game \\[5x5-quit-game]"
"Draw the grids GRIDS into the current buffer."
(let ((inhibit-read-only t) grid-org)
(erase-buffer)
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_ grids) (5x5-draw-grid-end))
(insert "\n")
(setq grid-org (point))
(dotimes (y 5x5-grid-size)
- (dotimes (lines 5x5-y-scale)
+ (dotimes (_lines 5x5-y-scale)
(dolist (grid grids)
(dotimes (x 5x5-grid-size)
(insert (if (zerop x) "| " " ")
@@ -331,7 +332,7 @@ Quit current game \\[5x5-quit-game]"
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_grid grids) (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids))
5x5-moves))))
@@ -475,11 +476,11 @@ position."
"Convert a grid matrix GRID-MATRIX in Calc format to a grid in
5x5 format. See function `5x5-grid-to-vec'."
(apply
- 'vector
+ #'vector
(mapcar
(lambda (x)
(apply
- 'vector
+ #'vector
(mapcar
(lambda (y) (/= (cadr y) 0))
(cdr x))))
@@ -503,7 +504,9 @@ position."
Log a matrix VALUE of (mod B 2) forms, only B is output and
Scilab matrix notation is used. VALUE is returned so that it is
easy to log a value with minimal rewrite of code."
- (when (buffer-live-p 5x5-log-buffer)
+ (when (buffer-live-p 5x5-log-buffer)
+ (defvar calc-matrix-brackets)
+ (defvar calc-vector-commas)
(let* ((unpacked-value
(math-map-vec
(lambda (row) (math-map-vec 'cadr row))
@@ -515,7 +518,7 @@ easy to log a value with minimal rewrite of code."
(insert name ?= value-to-log ?\n))))
value))
(defsubst 5x5-log-init ())
- (defsubst 5x5-log (name value) value)))
+ (defsubst 5x5-log (_name value) value)))
(declare-function math-map-vec "calc-vec" (f a))
(declare-function math-sub "calc" (a b))
@@ -533,6 +536,10 @@ easy to log a value with minimal rewrite of code."
(declare-function calcFunc-mcol "calc-vec" (mat n))
(declare-function calcFunc-vconcat "calc-vec" (a b))
(declare-function calcFunc-index "calc-vec" (n &optional start incr))
+(defvar calc-word-size)
+(defvar calc-leading-zeros)
+(defvar calc-number-radix)
+(defvar calc-command-flags)
(defun 5x5-solver (grid)
"Return a list of solutions for GRID.
@@ -671,16 +678,16 @@ Solutions are sorted from least to greatest Hamming
weight."
(5x5-log
"cb"
(math-mul inv-base-change targetv))); CB
- (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
+ ;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
(row-2 (math-make-intv 1 transferm-kernel-size
grid-size-squared)); 3..25
(col-1 (math-make-intv 3 1 (- grid-size-squared
transferm-kernel-size))); 1..23
- (col-2 (math-make-intv 1 (- grid-size-squared
- transferm-kernel-size)
- grid-size-squared)); 24..25
- (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
- (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
+ ;; (col-2 (math-make-intv 1 (- grid-size-squared
+ ;; transferm-kernel-size)
+ ;; grid-size-squared)) ; 24..25
+ ;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
+ ;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
;; and ctransferm-2-2 = 0.
@@ -696,8 +703,8 @@ Solutions are sorted from least to greatest Hamming weight."
;;
;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
- (ctarget-1 (calcFunc-mrow ctarget row-1))
- (ctarget-2 (calcFunc-mrow ctarget row-2))
+ ;; (ctarget-1 (calcFunc-mrow ctarget row-1))
+ (ctarget-2 (calcFunc-mrow ctarget row-2))
;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
;; + ctransferm-1-2(2x2) *cx-2(2x1);
@@ -770,13 +777,13 @@ Solutions are sorted from least to greatest Hamming
weight."
(message "5x5 Solution computation done.")
solution-list)))
-(defun 5x5-solve-suggest (&optional n)
+(defun 5x5-solve-suggest (&optional _n)
"Suggest to the user where to click.
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
@@ -799,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)
@@ -833,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))
@@ -845,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
@@ -857,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 e3854b5..13bcdcc 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,4 +1,4 @@
-;;; blackbox.el --- blackbox game in Emacs Lisp
+;;; blackbox.el --- blackbox game in Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
@@ -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/cookie1.el b/lisp/play/cookie1.el
index 5255d81..be35daf 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,4 +1,4 @@
-;;; cookie1.el --- retrieve random phrases from fortune cookie files
+;;; cookie1.el --- retrieve random phrases from fortune cookie files -*-
lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -177,11 +177,12 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie."
"Randomly permute the elements of VECTOR (all permutations equally likely)."
(let ((len (length vector))
j temp)
- (dotimes (i len vector)
+ (dotimes (i len)
(setq j (+ i (random (- len i)))
temp (aref vector i))
(aset vector i (aref vector j))
- (aset vector j temp))))
+ (aset vector j temp))
+ vector))
(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4")
@@ -204,9 +205,10 @@ If called interactively, or if DISPLAY is non-nil, display
a list of matches."
(cookie-table-symbol (intern phrase-file cookie-cache))
(string-table (symbol-value cookie-table-symbol))
(matches nil))
- (and (dotimes (i (length string-table) matches)
- (and (string-match-p regexp (aref string-table i))
- (setq matches (cons (aref string-table i) matches))))
+ (dotimes (i (length string-table))
+ (and (string-match-p regexp (aref string-table i))
+ (setq matches (cons (aref string-table i) matches))))
+ (and matches
(setq matches (sort matches 'string-lessp)))
(and display
(if matches
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/doctor.el b/lisp/play/doctor.el
index 028f04c..46fd852 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,4 +1,4 @@
-;;; doctor.el --- psychological help for frustrated users
+;;; doctor.el --- psychological help for frustrated users -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 1c2c24a..c6aef02 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,4 +1,4 @@
-;;; gametree.el --- manage game analysis trees in Emacs
+;;; gametree.el --- manage game analysis trees in Emacs -*- lexical-binding:
t -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
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/play/hanoi.el b/lisp/play/hanoi.el
index f6e5fcd..ac28fba 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -1,4 +1,4 @@
-;;; hanoi.el --- towers of hanoi in Emacs
+;;; hanoi.el --- towers of hanoi in Emacs -*- lexical-binding: t -*-
;; Author: Damon Anton Permezel
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index bed7cea..29effa2 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -336,38 +336,38 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-move-left ()
"Make the snake move left."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(-1 0) snake-velocity-queue)))
(defun snake-move-right ()
"Make the snake move right."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(1 0) snake-velocity-queue)))
(defun snake-move-up ()
"Make the snake move up."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 -1) snake-velocity-queue)))
(defun snake-move-down ()
"Make the snake move down."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 1) snake-velocity-queue)))
(defun snake-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil snake-mode)
(gamegrid-kill-timer)
(use-local-map snake-null-map)
(gamegrid-add-score snake-score-file snake-score))
(defun snake-start-game ()
"Start a new game of Snake."
- (interactive)
+ (interactive nil snake-mode)
(snake-reset-game)
(snake-set-dot)
(use-local-map snake-mode-map)
@@ -375,7 +375,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil snake-mode)
(setq snake-paused (not snake-paused))
(message (and snake-paused "Game paused (press p to resume)")))
@@ -386,6 +386,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(define-derived-mode snake-mode special-mode "Snake"
"A mode for playing Snake."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 05e4ffe..f43aa47 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -506,7 +506,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-bottom ()
"Drop the shape to the bottom of the playing area."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(let ((hit nil))
(tetris-erase-shape)
@@ -519,7 +519,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-left ()
"Move the shape one square to the left."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1- tetris-pos-x))
@@ -529,7 +529,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-right ()
"Move the shape one square to the right."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1+ tetris-pos-x))
@@ -539,7 +539,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-down ()
"Move the shape one square to the bottom."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-y (1+ tetris-pos-y))
@@ -549,7 +549,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-prev ()
"Rotate the shape clockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 1 tetris-rot)
@@ -561,7 +561,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-next ()
"Rotate the shape anticlockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 3 tetris-rot)
@@ -573,14 +573,14 @@ Drops the shape one square, testing for collision."
(defun tetris-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil tetris-mode)
(gamegrid-kill-timer)
(use-local-map tetris-null-map)
(gamegrid-add-score tetris-score-file tetris-score))
(defun tetris-start-game ()
"Start a new game of Tetris."
- (interactive)
+ (interactive nil tetris-mode)
(tetris-reset-game)
(use-local-map tetris-mode-map)
(let ((period (or (tetris-get-tick-period)
@@ -589,7 +589,7 @@ Drops the shape one square, testing for collision."
(defun tetris-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil tetris-mode)
(setq tetris-paused (not tetris-paused))
(message (and tetris-paused "Game paused (press p to resume)")))
@@ -600,6 +600,7 @@ Drops the shape one square, testing for collision."
(define-derived-mode tetris-mode nil "Tetris"
"A mode for playing Tetris."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 70b6a01..19e4e39 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,4 +1,4 @@
-;;; zone.el --- idle display hacks
+;;; zone.el --- idle display hacks -*- lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -128,14 +128,17 @@ If the element is a function or a list of a function and
a number,
(let ((pgm (elt zone-programs (random (length zone-programs))))
(ct (and f (frame-parameter f 'cursor-type)))
(show-trailing-whitespace nil)
- (restore (list '(kill-buffer outbuf))))
+ restore)
(when ct
- (modify-frame-parameters f '((cursor-type . (bar . 0))))
- (setq restore (cons '(modify-frame-parameters
- f (list (cons 'cursor-type ct)))
- restore)))
+ (modify-frame-parameters f '((cursor-type . (bar . 0)))))
;; Make `restore' a self-disabling one-shot thunk.
- (setq restore `(lambda () ,@restore (setq restore nil)))
+ (setq restore
+ (lambda ()
+ (when ct
+ (modify-frame-parameters
+ f (list (cons 'cursor-type ct))))
+ (kill-buffer outbuf)
+ (setq restore nil)))
(condition-case nil
(progn
(message "Zoning... (%s)" pgm)
@@ -419,7 +422,7 @@ If the element is a function or a list of a function and a
number,
(defsubst zone-replace-char (count del-count char-as-string new-value)
(delete-char (or del-count (- count)))
(aset char-as-string 0 new-value)
- (dotimes (i count) (insert char-as-string)))
+ (dotimes (_ count) (insert char-as-string)))
(defsubst zone-park/sit-for (pos seconds)
(let ((p (point)))
@@ -460,7 +463,7 @@ If the element is a function or a list of a function and a
number,
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(setq line (concat line "\n"))
- (dotimes (i nl)
+ (dotimes (_ nl)
(insert line))))
(goto-char start)
(recenter 0)
diff --git a/lisp/plstore.el b/lisp/plstore.el
index 4653366..4ca5886 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -1,4 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
+
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
@@ -19,7 +20,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary
+;;; Commentary:
;; Plist based data store providing search and partial encryption.
;;
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index e5b9ac0..d92c8c3 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1246,9 +1246,8 @@ IF TOKENREFS-ONLY is non-nil, just return alist with
tokenref names."
(let ((items nil)
(classes nil)
(continue t))
- ;; Using `imenu-progress-message' would require imenu for compilation, but
- ;; nobody is missing these messages. The generic imenu function searches
- ;; backward, which is slower and more likely not to work during editing.
+ ;; The generic imenu function searches backward, which is slower
+ ;; and more likely not to work during editing.
(antlr-with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(goto-char (point-min))
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/cc-engine.el b/lisp/progmodes/cc-engine.el
index 484624b..9038c7b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2665,7 +2665,7 @@ comment at the start of cc-engine.el for more info."
;; One of the above "near" caches is associated with each of these functions.
;;
;; When searching this cache, these functions first seek an exact match, then
-;; a "close" match from the assiciated near cache. If neither of these
+;; a "close" match from the associated near cache. If neither of these
;; succeed, the nearest preceding entry in the far cache is used.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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/compile.el b/lisp/progmodes/compile.el
index 614ed7d..48b5ee9 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2069,6 +2069,10 @@ Returns the compilation buffer created."
(define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
+ (define-key map "n" 'next-error-no-select)
+ (define-key map "p" 'previous-error-no-select)
+ (define-key map "l" 'recenter-current-error)
+
(define-key map "g" 'recompile) ; revert
;; Set up the menu-bar
(define-key map [menu-bar compilation]
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index a70e8e3..db142c0 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
+ (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
@@ -1665,12 +1764,12 @@ or as help on variables `cperl-tips', `cperl-problems',
(setq-local syntax-propertize-function
(lambda (start end)
(goto-char start)
- ;; Even if cperl-fontify-syntaxically has already gone
+ ;; Even if cperl-fontify-syntactically has already gone
;; beyond `start', syntax-propertize has just removed
;; syntax-table properties between start and end, so we have
;; to re-apply them.
(setq cperl-syntax-done-to start)
- (cperl-fontify-syntaxically end))))
+ (cperl-fontify-syntactically end))))
(setq cperl-font-lock-multiline t) ; Not localized...
(setq-local font-lock-multiline t)
(setq-local font-lock-fontify-region-function
@@ -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
@@ -8387,7 +8407,7 @@ do extra unwind via `cperl-unwind-to-safe'."
(setq end (point)))
(font-lock-default-fontify-region beg end loudly))
-(defun cperl-fontify-syntaxically (end)
+(defun cperl-fontify-syntactically (end)
;; Some vars for debugging only
;; (message "Syntaxifying...")
(let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
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/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 9348a7f..397eb26 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -904,7 +904,13 @@ non-nil result supersedes the xrefs produced by
(point-marker)))))))
(cl-defmethod xref-location-group ((l xref-elisp-location))
- (xref-elisp-location-file l))
+ (let ((file (xref-elisp-location-file l)))
+ (defvar find-function-C-source-directory)
+ (if (and find-function-C-source-directory
+ (string-match-p "\\`src/" file))
+ (concat find-function-C-source-directory
+ (substring file 3))
+ file)))
(defun elisp-load-path-roots ()
(if (boundp 'package-user-dir)
@@ -1268,7 +1274,8 @@ If `eval-expression-debug-on-error' is non-nil, which is
the default,
this command arranges for all errors to enter the debugger."
(interactive "P")
(if (null eval-expression-debug-on-error)
- (elisp--eval-last-sexp eval-last-sexp-arg-internal)
+ (values--store-value
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal))
(let ((value
(let ((debug-on-error elisp--eval-last-sexp-fake-value))
(cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
@@ -1335,9 +1342,11 @@ if it already has a value.)
Return the result of evaluation."
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
+ (defvar elisp--eval-defun-result)
(let ((debug-on-error eval-expression-debug-on-error)
(print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
+ (print-level eval-expression-print-level)
+ elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
;; eval-region handles recording which file defines a function or
@@ -1349,21 +1358,25 @@ Return the result of evaluation."
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
- (setq form (read (current-buffer)))
+ (setq form (funcall load-read-function (current-buffer)))
(setq end (point)))
;; Alter the form if necessary.
(let ((form (eval-sexp-add-defvars
- (elisp--eval-defun-1 (macroexpand form)))))
+ (elisp--eval-defun-1
+ (macroexpand form)))))
(eval-region beg end standard-output
(lambda (_ignore)
;; Skipping to the end of the specified region
;; will make eval-region return.
(goto-char end)
- form))))))
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str)))
- ;; The result of evaluation has been put onto VALUES. So return it.
- (car values))
+ ;; This `setq' needs to be added *after* passing
+ ;; form through `elisp--eval-defun-1' since it
+ ;; would otherwise "hide" forms like `defvar's and
+ ;; thus defeat their special treatment.
+ `(setq elisp--eval-defun-result ,form))))))
+ (let ((str (eval-expression-print-format elisp--eval-defun-result)))
+ (if str (princ str)))
+ elisp--eval-defun-result))
(defun eval-defun (edebug-it)
"Evaluate the top-level form containing point, or after point.
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..d018032 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -483,7 +483,7 @@ Currently, Flymake may provide these keyword-value pairs:
* `:recent-changes', a list of recent changes since the last time
the backend function was called for the buffer. An empty list
- indicates that no changes have been reocrded. If it is the
+ indicates that no changes have been recorded. If it is the
first time that this backend function is called for this
activation of `flymake-mode', then this argument isn't provided
at all (i.e. it's not merely nil).
@@ -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/grep.el b/lisp/progmodes/grep.el
index 1a8435f..d6ee8bb 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -275,8 +275,6 @@ See `compilation-error-screen-columns'."
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
(define-key map "\r" 'compile-goto-error) ;; ?
- (define-key map "n" 'next-error-no-select)
- (define-key map "p" 'previous-error-no-select)
(define-key map "{" 'compilation-previous-file)
(define-key map "}" 'compilation-next-file)
(define-key map "\t" 'compilation-next-error)
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 cb44b72..a8a8647 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -165,7 +165,7 @@ parenthetical grouping.")
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?! "." table)
(modify-syntax-entry ?\\ "." table)
- (modify-syntax-entry ?\' "\"" table)
+ (modify-syntax-entry ?\' "." table)
(modify-syntax-entry ?\` "." table)
(modify-syntax-entry ?. "." table)
(modify-syntax-entry ?\" "\"" table)
@@ -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/tcl.el b/lisp/progmodes/tcl.el
index 0a0118a..82e1343 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -651,7 +651,6 @@ already exist."
(setq-local add-log-current-defun-function
#'tcl-add-log-defun)
- (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function)
(setq-local end-of-defun-function #'tcl-end-of-defun-function))
@@ -849,14 +848,12 @@ Returns nil if line starts inside a string, t if in a
comment."
state
containing-sexp
found-next-line)
- (cond
- (parse-start
+
+ (if parse-start
(goto-char parse-start))
- ((not (beginning-of-defun))
- ;; If we're not in a function, don't use
- ;; `tcl-beginning-of-defun-function'.
- (let ((beginning-of-defun-function nil))
- (beginning-of-defun))))
+
+ (beginning-of-defun)
+
(while (< (point) indent-point)
(setq parse-start (point))
(setq state (parse-partial-sexp (point) indent-point 0))
@@ -1035,22 +1032,6 @@ Returns nil if line starts inside a string, t if in a
comment."
;; Interfaces to other packages.
;;
-(defun tcl-beginning-of-defun-function (&optional arg)
- "`beginning-of-defun-function' for Tcl mode."
- (when (or (not arg) (= arg 0))
- (setq arg 1))
- (let* ((search-fn (if (> arg 0)
- ;; Positive arg means to search backward.
- #'re-search-backward
- #'re-search-forward))
- (arg (abs arg))
- (result t))
- (while (and (> arg 0) result)
- (unless (funcall search-fn tcl-proc-regexp nil t)
- (setq result nil))
- (setq arg (1- arg)))
- result))
-
(defun tcl-end-of-defun-function ()
"`end-of-defun-function' for Tcl mode."
;; Because we let users redefine tcl-proc-list, we don't really know
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index f934ef7..55c04e1 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -134,7 +134,7 @@
(interactive)
(message "Using verilog-mode version %s" verilog-mode-version))
-(defmacro verilog--supressed-warnings (warnings &rest body)
+(defmacro verilog--suppressed-warnings (warnings &rest body)
(declare (indent 1) (debug t))
(cond
((fboundp 'with-suppressed-warnings)
@@ -5550,7 +5550,7 @@ FILENAME to find directory to run in, or defaults to
`buffer-file-name'."
;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
;; solve only appears in Emacsen older than font-lock-ensure anyway.
(when fontlocked
- (verilog--supressed-warnings
+ (verilog--suppressed-warnings
((interactive-only font-lock-fontify-buffer))
(font-lock-fontify-buffer))))))))
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/registry.el b/lisp/registry.el
index a5c30f2..258f7fc 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -1,4 +1,4 @@
-;;; registry.el --- Track and remember data items by various fields
+;;; registry.el --- Track and remember data items by various fields -*-
lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -128,7 +128,7 @@
:type hash-table
:documentation "The data hash table.")))
-(cl-defmethod initialize-instance :before ((this registry-db) slots)
+(cl-defmethod initialize-instance :before ((_this registry-db) slots)
"Check whether a registry object needs to be upgraded."
;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the
;; :max-soft slot to disappear, and the :max-hard slot to be renamed
@@ -212,7 +212,7 @@ When SET is not nil, set it for VAL (use t for an empty
list)."
(:regex
(string-match (car vals)
(mapconcat
- 'prin1-to-string
+ #'prin1-to-string
(cdr-safe (assoc key entry))
"\0"))))
vals (cdr-safe vals)))
@@ -247,7 +247,7 @@ Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
(let* ((data (oref db data))
(keys (or keys
- (apply 'registry-search db spec)))
+ (apply #'registry-search db spec)))
(tracked (oref db tracked)))
(dolist (key keys)
@@ -308,19 +308,18 @@ Errors out if the key exists already."
(let ((count 0)
(expected (* (length (oref db tracked)) (registry-size db))))
(dolist (tr (oref db tracked))
- (let (values)
- (maphash
- (lambda (key v)
- (cl-incf count)
- (when (and (< 0 expected)
- (= 0 (mod count 1000)))
- (message "reindexing: %d of %d (%.2f%%)"
- count expected (/ (* 100.0 count) expected)))
- (dolist (val (cdr-safe (assq tr v)))
- (let ((value-keys (registry-lookup-secondary-value db tr val)))
- (push key value-keys)
- (registry-lookup-secondary-value db tr val value-keys))))
- (oref db data))))))
+ (maphash
+ (lambda (key v)
+ (cl-incf count)
+ (when (and (< 0 expected)
+ (= 0 (mod count 1000)))
+ (message "reindexing: %d of %d (%.2f%%)"
+ count expected (/ (* 100.0 count) expected)))
+ (dolist (val (cdr-safe (assq tr v)))
+ (let ((value-keys (registry-lookup-secondary-value db tr val)))
+ (push key value-keys)
+ (registry-lookup-secondary-value db tr val value-keys))))
+ (oref db data)))))
(cl-defmethod registry-prune ((db registry-db) &optional sortfunc)
"Prune the registry-db object DB.
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/replace.el b/lisp/replace.el
index d320542..eb7a439 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1161,6 +1161,7 @@ a previously found match."
(define-key map "\C-o" 'occur-mode-display-occurrence)
(define-key map "n" 'next-error-no-select)
(define-key map "p" 'previous-error-no-select)
+ (define-key map "l" 'recenter-current-error)
(define-key map "\M-n" 'occur-next)
(define-key map "\M-p" 'occur-prev)
(define-key map "r" 'occur-rename-buffer)
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 6611f42..42cb349 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
@@ -492,6 +496,16 @@ buffer causes automatic display of the corresponding
source code location."
(overlay-put ol 'window (get-buffer-window))
(setf next-error--message-highlight-overlay ol)))))
+(defun recenter-current-error (&optional arg)
+ "Recenter the current displayed error in the `next-error' buffer."
+ (interactive "P")
+ (save-selected-window
+ (let ((next-error-highlight next-error-highlight-no-select)
+ (display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (next-error 0)
+ (set-buffer (window-buffer))
+ (recenter-top-bottom arg))))
;;;
@@ -535,7 +549,7 @@ It must be called via `run-hook-with-args-until-success'
with no arguments.
If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper') and will
usually delete the region. If all the functions on this hook return
-nil, it is an indiction that `self-insert-command' needs the region
+nil, it is an indication that `self-insert-command' needs the region
untouched by `delete-selection-mode' and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' that acts on the region should
@@ -1264,7 +1278,19 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defvar-local goto-line-history nil
+(defcustom goto-line-history-local nil
+ "If this option is nil, `goto-line-history' is shared between all buffers.
+If it is non-nil, each buffer has its own value of this history list.
+
+Note that on changing from non-nil to nil, the former contents of
+`goto-line-history' for each buffer are discarded on use of
+`goto-line' in that buffer."
+ :group 'editing
+ :type 'boolean
+ :safe #'booleanp
+ :version "28.1")
+
+(defvar goto-line-history nil
"History of values entered with `goto-line'.")
(defun goto-line-read-args (&optional relative)
@@ -1282,6 +1308,11 @@ that uses or sets the mark."
(if buffer
(concat " in " (buffer-name buffer))
"")))
+ ;; Has the buffer locality of `goto-line-history' changed?
+ (cond ((and goto-line-history-local (not (local-variable-p
'goto-line-history)))
+ (make-local-variable 'goto-line-history))
+ ((and (not goto-line-history-local) (local-variable-p
'goto-line-history))
+ (kill-local-variable 'goto-line-history)))
;; Read the argument, offering that number (if any) as default.
(list (read-number (format "Goto%s line%s: "
(if (buffer-narrowed-p)
@@ -1443,9 +1474,9 @@ included in the count."
(save-excursion
(save-restriction
(narrow-to-region start end)
- (goto-char (point-min))
(cond ((and (not ignore-invisible-lines)
(eq selective-display t))
+ (goto-char (point-min))
(save-match-data
(let ((done 0))
(while (re-search-forward "\n\\|\r[^\n]" nil t 40)
@@ -1458,6 +1489,7 @@ included in the count."
(1+ done)
done))))
(ignore-invisible-lines
+ (goto-char (point-min))
(save-match-data
(- (buffer-size)
(forward-line (buffer-size))
@@ -1472,27 +1504,11 @@ included in the count."
(assq prop buffer-invisibility-spec)))
(setq invisible-count (1+ invisible-count))))
invisible-count))))
- (t (- (buffer-size) (forward-line (buffer-size))))))))
-
-(defun line-number-at-pos (&optional pos absolute)
- "Return buffer line number at position POS.
-If POS is nil, use current buffer location.
-
-If ABSOLUTE is nil, the default, counting starts
-at (point-min), so the value refers to the contents of the
-accessible portion of the (potentially narrowed) buffer. If
-ABSOLUTE is non-nil, ignore any narrowing and return the
-absolute line number."
- (save-restriction
- (when absolute
- (widen))
- (let ((opoint (or pos (point))) start)
- (save-excursion
- (goto-char (point-min))
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (1+ (count-lines start (point)))))))
+ (t
+ (goto-char (point-max))
+ (if (bolp)
+ (1- (line-number-at-pos))
+ (line-number-at-pos)))))))
(defcustom what-cursor-show-names nil
"Whether to show character names in `what-cursor-position'."
@@ -1814,31 +1830,34 @@ this command arranges for all errors to enter the
debugger."
(cons (read--expression "Eval: ")
(eval-expression-get-print-arguments current-prefix-arg)))
- (if (null eval-expression-debug-on-error)
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (let ((print-length (unless no-truncate eval-expression-print-length))
- (print-level (unless no-truncate eval-expression-print-level))
- (eval-expression-print-maximum-character char-print-limit)
- (deactivate-mark))
- (let ((out (if insert-value (current-buffer) t)))
- (prog1
- (prin1 (car values) out)
- (let ((str (and char-print-limit
- (eval-expression-print-format (car values)))))
- (when str (princ str out)))))))
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (let ((print-length (unless no-truncate eval-expression-print-length))
+ (print-level (unless no-truncate eval-expression-print-level))
+ (eval-expression-print-maximum-character char-print-limit)
+ (deactivate-mark))
+ (let ((out (if insert-value (current-buffer) t)))
+ (prog1
+ (prin1 result out)
+ (let ((str (and char-print-limit
+ (eval-expression-print-format result))))
+ (when str (princ str out))))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
@@ -1902,55 +1921,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 function, 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))
@@ -5886,8 +5976,9 @@ START and END specify the portion of the current buffer
to be copied."
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
-It is also run at the end of a command, if the mark is active and
-it is possible that the region may have changed.")
+It is also run when the region is reactivated, for instance after
+using a command that switches back to a buffer that has an active
+mark.")
(defvar deactivate-mark-hook nil
"Hook run when the mark becomes inactive.")
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 6e52bd2..490aec9 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
@@ -772,7 +785,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))
@@ -922,14 +935,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)
@@ -966,8 +979,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)
@@ -1095,7 +1108,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)))
@@ -1655,6 +1668,12 @@ The return value has the form (WIDTH . HEIGHT).
POSITION should
be a list of the form returned by `event-start' and `event-end'."
(nth 9 position))
+(defun values--store-value (value)
+ "Store VALUE in the obsolete `values' variable."
+ (with-suppressed-warnings ((obsolete values))
+ (push value values))
+ value)
+
;;;; Obsolescent names for functions.
@@ -1721,32 +1740,36 @@ be a list of the form returned by `event-start' and
`event-end'."
(make-obsolete-variable 'load-dangerous-libraries
"no longer used." "27.1")
+;; We can't actually make `values' obsolete, because that will result
+;; in warnings when using `values' in let-bindings.
+;;(make-obsolete-variable 'values "no longer used" "28.1")
+
;;;; 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.
@@ -1860,7 +1883,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))
@@ -2072,9 +2095,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)))
@@ -2228,9 +2251,13 @@ Affects only hooks run in the current buffer."
;; PUBLIC: find if the current mode derives from another.
(defun provided-mode-derived-p (mode &rest modes)
- "Non-nil if MODE is derived from one of MODES or their aliases.
+ "Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
If you just want to check `major-mode', use `derived-mode-p'."
+ ;; If MODE is an alias, then look up the real mode function first.
+ (when-let ((alias (symbol-function mode)))
+ (when (symbolp alias)
+ (setq mode alias)))
(while
(and
(not (memq mode modes))
@@ -2288,7 +2315,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.
@@ -2501,7 +2529,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)
@@ -2547,7 +2575,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
@@ -2735,7 +2763,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 ?*)))
@@ -2745,8 +2773,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))))))))
@@ -2776,7 +2804,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
@@ -2930,13 +2958,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.")
@@ -2999,9 +3027,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))
@@ -3034,26 +3062,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.")
@@ -3350,7 +3378,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.
@@ -3494,7 +3522,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 ()
@@ -3508,8 +3536,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)))
@@ -3843,7 +3871,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)
@@ -3855,7 +3883,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.
@@ -4316,6 +4344,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)
@@ -4872,8 +4902,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)
@@ -4889,7 +4919,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.
@@ -4924,7 +4953,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.
@@ -5031,7 +5061,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 ()
@@ -5364,7 +5394,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)))
@@ -5529,7 +5559,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.
@@ -6157,7 +6187,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/bib-mode.el b/lisp/textmodes/bib-mode.el
index 1e22287..ec21987 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,4 +1,4 @@
-;;; bib-mode.el --- major mode for editing bib files
+;;; bib-mode.el --- major mode for editing bib files -*- lexical-binding: t
-*-
;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
@@ -39,13 +39,11 @@
(defcustom bib-file "~/my-bibliography.bib"
"Default name of file used by `addbib'."
- :type 'file
- :group 'bib)
+ :type 'file)
(defcustom unread-bib-file "~/to-be-read.bib"
"Default name of file used by `unread-bib' in Bib mode."
- :type 'file
- :group 'bib)
+ :type 'file)
(defvar bib-mode-map
(let ((map (make-sparse-keymap)))
@@ -138,8 +136,7 @@ with the cdr.")
(defcustom bib-auto-capitalize t
"True to automatically capitalize appropriate fields in Bib mode."
- :type 'boolean
- :group 'bib)
+ :type 'boolean)
(defconst bib-capitalized-fields "%[AETCBIJR]")
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index a22cd97..301f701 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3327,7 +3327,7 @@ Use `bibtex-summary-function' to generate summary."
(message "%s %s" key summary))))))
(defun bibtex-copy-summary-as-kill (&optional arg)
- "Push summery of current BibTeX entry to kill ring.
+ "Push summary of current BibTeX entry to kill ring.
Use `bibtex-summary-function' to generate summary.
If prefix ARG is non-nil push BibTeX entry's URL to kill ring
that is generated by calling `bibtex-url'."
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 23a6229..f1a7517 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,4 +1,4 @@
-;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
+;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-*- lexical-binding: t -*-
;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
@@ -70,23 +70,19 @@
(defface dns-mode-control-entity '((t :inherit font-lock-keyword-face))
"Face used for DNS control entities, e.g. $ORIGIN."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-bad-control-entity '((t :inherit font-lock-warning-face))
"Face used for non-standard DNS control entities, e.g. $FOO."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-type '((t :inherit font-lock-type-face))
"Face used for DNS types, e.g., SOA."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-class '((t :inherit font-lock-constant-face))
"Face used for DNS classes, e.g., IN."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defvar dns-mode-control-entity-face ''dns-mode-control-entity
"Name of face used for control entities, e.g. $ORIGIN.")
@@ -121,8 +117,7 @@
(,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face))
"Font lock keywords used to highlight text in DNS master file mode."
:version "26.1"
- :type 'sexp
- :group 'dns-mode)
+ :type 'sexp)
(defcustom dns-mode-soa-auto-increment-serial t
"Whether to increment the SOA serial number automatically.
@@ -134,8 +129,7 @@ manually with \\[dns-mode-soa-increment-serial]."
:type '(choice (const :tag "Always" t)
(const :tag "Ask" ask)
(const :tag "Never" nil))
- :safe 'symbolp
- :group 'dns-mode)
+ :safe 'symbolp)
;; Syntax table.
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index bac209c..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.
@@ -186,7 +181,6 @@ The value is a list of \(VAR VALUE VAR VALUE...).")
(defvar enriched-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [remap move-beginning-of-line] 'beginning-of-line-text)
(define-key map "\C-m" 'reindent-then-newline-and-indent)
(define-key map
[remap newline-and-indent] 'reindent-then-newline-and-indent)
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/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index fe70e92..e7d852b 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -316,7 +316,7 @@ otherwise off."
(save-buffer))
(if viewbuf
(kill-buffer viewbuf))
- (Man-getpage-in-background file)))
+ (Man-getpage-in-background (shell-quote-argument file))))
(provide 'nroff-mode)
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/texinfmt.el b/lisp/textmodes/texinfmt.el
index ed0a367..fe052e3 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -28,10 +28,12 @@
;;; Emacs lisp functions to convert Texinfo files to Info files.
(defvar texinfmt-version "2.42 of 7 Jul 2006")
+(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1")
(defun texinfmt-version (&optional here)
"Show the version of texinfmt.el in the minibuffer.
If optional argument HERE is non-nil, insert info at point."
+ (declare (obsolete emacs-version "28.1"))
(interactive "P")
(let ((version-string
(format-message "Version of `texinfmt.el': %s" texinfmt-version)))
@@ -345,8 +347,8 @@ converted to Info is stored in a temporary buffer."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Now convert for real.
@@ -489,8 +491,8 @@ if large. You can use `Info-split' to do this manually."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Return data for indices.
(list outfile
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/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index ea35641..04778ee 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1033,7 +1033,7 @@ However, there does not need to be a title field."
(save-excursion
;; `master-menu-inserted-p' is a kludge to tell
- ;; whether to insert @end detailmenu (see bleow)
+ ;; whether to insert @end detailmenu (see below)
(let (master-menu-inserted-p)
;; Handle top of menu
(insert "\n@menu\n")
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 1432ab6..ab9f7b9 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -169,8 +169,6 @@ both existing buffers and buffers that you subsequently
create."
(if enable-mode "enabled" "disabled"))))
-(define-key facemenu-keymap "\eS" 'center-paragraph)
-
(defun center-paragraph ()
"Center each nonblank line in the paragraph at or after point.
See `center-line' for more info."
@@ -198,8 +196,6 @@ See `center-line' for more info."
(center-line))
(forward-line 1)))))
-(define-key facemenu-keymap "\es" 'center-line)
-
(defun center-line (&optional nlines)
"Center the line point is on, within the width specified by `fill-column'.
This means adjusting the indentation so that it equals
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/url/url-http.el b/lisp/url/url-http.el
index 8cebd4e..e3c1786 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The
first
element in CBARGS should be a plist describing what has happened
so far during the request, as described in the docstring of
`url-retrieve' (if in doubt, specify nil). The current buffer
-then CALLBACK is executed is the retrieval buffer.
+when CALLBACK is executed is the retrieval buffer.
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 6e65816..3f33e6a 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -980,8 +980,10 @@ this variable represents.")
(defface ediff-even-diff-A
`((((type pc))
(:foreground "green3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -999,8 +1001,10 @@ widget to customize the actual face object
`ediff-even-diff-A'
this variable represents.")
(defface ediff-even-diff-B
- `((((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ `((((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1019,8 +1023,10 @@ this variable represents.")
(defface ediff-even-diff-C
`((((type pc))
(:foreground "yellow3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -1040,8 +1046,10 @@ this variable represents.")
(defface ediff-even-diff-Ancestor
`((((type pc))
(:foreground "cyan3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1068,8 +1076,10 @@ this variable represents.")
(defface ediff-odd-diff-A
'((((type pc))
(:foreground "green3" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1088,8 +1098,10 @@ this variable represents.")
(defface ediff-odd-diff-B
'((((type pc))
(:foreground "White" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -1108,8 +1120,10 @@ this variable represents.")
(defface ediff-odd-diff-C
'((((type pc))
(:foreground "yellow3" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index f955ba8..9909dcd 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -3998,8 +3998,8 @@ Mail anyway? (y or n) ")
(define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark
"27.1")
(defun ediff-activate-mark ()
- (make-local-variable 'transient-mark-mode)
- (setq mark-active 'ediff-util transient-mark-mode t))
+ (setq mark-active 'ediff-util)
+ (setq-local transient-mark-mode t))
(define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1")
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/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index c495afb..d1385ea 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1076,49 +1076,49 @@ stream. Standard error output is discarded."
(when (string-match ".+checkout of branch: \\(.+\\)$" str)
(match-string 1 str)))))
(concat
- (propertize "Parent branch : " 'face 'font-lock-type-face)
+ (propertize "Parent branch : " 'face 'vc-dir-header)
(propertize
(if (string-match "parent branch: \\(.+\\)$" str)
(match-string 1 str)
"None")
- 'face 'font-lock-variable-name-face)
+ 'face 'vc-dir-header-value)
"\n"
(when light-checkout
(concat
- (propertize "Light checkout root: " 'face 'font-lock-type-face)
- (propertize light-checkout 'face 'font-lock-variable-name-face)
+ (propertize "Light checkout root: " 'face 'vc-dir-header)
+ (propertize light-checkout 'face 'vc-dir-header-value)
"\n"))
(when light-checkout-branch
(concat
- (propertize "Checkout of branch : " 'face 'font-lock-type-face)
- (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
+ (propertize "Checkout of branch : " 'face 'vc-dir-header)
+ (propertize light-checkout-branch 'face 'vc-dir-header-value)
"\n"))
(when pending-merge
(concat
- (propertize "Warning : " 'face 'font-lock-warning-face
+ (propertize "Warning : " 'face 'vc-dir-status-warning
'help-echo pending-merge-help-echo)
(propertize "Pending merges, commit recommended before any other
action"
'help-echo pending-merge-help-echo
- 'face 'font-lock-warning-face)
+ 'face 'vc-dir-status-warning)
"\n"))
(if shelve
(concat
- (propertize "Shelves :\n" 'face 'font-lock-type-face
+ (propertize "Shelves :\n" 'face 'vc-dir-header
'help-echo shelve-help-echo)
(mapconcat
(lambda (x)
(propertize x
- 'face 'font-lock-variable-name-face
+ 'face 'vc-dir-header-value
'mouse-face 'highlight
'help-echo "mouse-3: Show shelve menu\nA: Apply and
keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k:
Delete shelf"
'keymap vc-bzr-shelve-map))
shelve "\n"))
(concat
- (propertize "Shelves : " 'face 'font-lock-type-face
+ (propertize "Shelves : " 'face 'vc-dir-header
'help-echo shelve-help-echo)
(propertize "No shelved changes"
'help-echo shelve-help-echo
- 'face 'font-lock-variable-name-face))))))
+ 'face 'vc-dir-header-value))))))
;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-resynch-buffer "vc-dispatcher"
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a595cc9..0adb532 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil."
(file-error nil))))
(concat
(cond (repo
- (concat (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t ""))
(cond (module
- (concat (propertize "Module : " 'face 'font-lock-type-face)
- (propertize module 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Module : " 'face 'vc-dir-header)
+ (propertize module 'face 'vc-dir-header-value)))
(t ""))
(if (file-readable-p "CVS/Tag")
(let ((tag (vc-cvs-file-to-string "CVS/Tag")))
(cond
((string-match "\\`T" tag)
- (concat (propertize "Tag : " 'face 'font-lock-type-face)
+ (concat (propertize "Tag : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
((string-match "\\`D" tag)
- (concat (propertize "Date : " 'face 'font-lock-type-face)
+ (concat (propertize "Date : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
(t ""))))
;; In CVS, branch is a per-file property, not a per-directory property.
;; We can't really do this here without making dangerous assumptions.
- ;;(propertize "Branch: " 'face 'font-lock-type-face)
+ ;;(propertize "Branch: " 'face 'vc-dir-header)
;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
;; 'face 'font-lock-warning-face)
)))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9d0808c..a416474 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -54,6 +54,42 @@ See `run-hooks'."
:type 'hook
:group 'vc)
+(defface vc-dir-header '((t :inherit font-lock-type-face))
+ "Face for headers in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face))
+ "Face for header values in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face))
+ "Face for directories in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-file '((t :inherit font-lock-function-name-face))
+ "Face for files in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face))
+ "Face for mark indicators in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-status-warning '((t :inherit font-lock-warning-face))
+ "Face for warning status in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face))
+ "Face for edited status in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face))
+ "Face for up-to-date status in VC-dir buffers."
+ :group 'vc)
+
+(defface vc-dir-status-ignored '((t :inherit shadow))
+ "Face for ignored or empty values in VC-dir buffers."
+ :group 'vc)
+
;; Used to store information for the files displayed in the directory buffer.
;; Each item displayed corresponds to one of these defstructs.
(cl-defstruct (vc-dir-fileinfo
@@ -1126,11 +1162,11 @@ It calls the `dir-extra-headers' backend method to
display backend
specific headers."
(concat
;; First layout the common headers.
- (propertize "VC backend : " 'face 'font-lock-type-face)
- (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
- (propertize "Working dir: " 'face 'font-lock-type-face)
+ (propertize "VC backend : " 'face 'vc-dir-header)
+ (propertize (format "%s\n" backend) 'face 'vc-dir-header-value)
+ (propertize "Working dir: " 'face 'vc-dir-header)
(propertize (format "%s\n" (abbreviate-file-name dir))
- 'face 'font-lock-variable-name-face)
+ 'face 'vc-dir-header-value)
;; Then the backend specific ones.
(vc-call-backend backend 'dir-extra-headers dir)
"\n"))
@@ -1386,9 +1422,9 @@ These are the commands available for use in the file
status buffer:
;; backend specific headers.
;; XXX: change this to return nil before the release.
(concat
- (propertize "Extra : " 'face 'font-lock-type-face)
+ (propertize "Extra : " 'face 'vc-dir-header)
(propertize "Please add backend specific headers here. It's easy!"
- 'face 'font-lock-warning-face)))
+ 'face 'vc-dir-status-warning)))
(defvar vc-dir-status-mouse-map
(let ((map (make-sparse-keymap)))
@@ -1414,21 +1450,23 @@ These are the commands available for use in the file
status buffer:
(insert
(propertize
(format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
- 'face 'font-lock-type-face)
+ 'face 'vc-dir-mark-indicator)
" "
(propertize
(format "%-20s" state)
- 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
- ((memq state '(missing conflict)) 'font-lock-warning-face)
- ((eq state 'edited) 'font-lock-constant-face)
- (t 'font-lock-variable-name-face))
+ 'face (cond
+ ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
+ ((memq state '(missing conflict needs-update unlocked-changes))
+ 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
+ (t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" "
(propertize
(format "%s" filename)
'face
- (if isdir 'font-lock-comment-delimiter-face
'font-lock-function-name-face)
+ (if isdir 'vc-dir-directory 'vc-dir-file)
'help-echo
(if isdir
"Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index d00c2c2..25ae26d 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -462,7 +462,7 @@ or an empty string if none."
(eq 0 (logand ?\111 (logxor old-perm new-perm))))
" "
(if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
- 'face 'font-lock-type-face))
+ 'face 'vc-dir-header))
(defun vc-git-dir-printer (info)
"Pretty-printer for the vc-dir-fileinfo structure."
@@ -474,20 +474,21 @@ or an empty string if none."
(insert
" "
(propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
- 'face 'font-lock-type-face)
+ 'face 'vc-dir-mark-indicator)
" "
(propertize
(format "%-12s" state)
- 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
- ((eq state '(missing conflict)) 'font-lock-warning-face)
- (t 'font-lock-variable-name-face))
+ 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
+ ((memq state '(missing conflict)) 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
+ (t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" " (vc-git-permissions-as-string old-perm new-perm)
" "
(propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
- 'face (if isdir 'font-lock-comment-delimiter-face
- 'font-lock-function-name-face)
+ 'face (if isdir 'vc-dir-directory
+ 'vc-dir-file)
'help-echo
(if isdir
"Directory\nVC operations can be applied to it\nmouse-3:
Pop-up menu"
@@ -784,7 +785,7 @@ or an empty string if none."
(mapconcat
(lambda (x)
(propertize x
- 'face 'font-lock-variable-name-face
+ 'face 'vc-dir-header-value
'mouse-face 'highlight
'vc-git-hideable all-hideable
'help-echo vc-git-stash-list-help
@@ -800,7 +801,7 @@ or an empty string if none."
(mapconcat
(lambda (x)
(propertize x
- 'face 'font-lock-variable-name-face
+ 'face 'vc-dir-header-value
'mouse-face 'highlight
'invisible t
'vc-git-hideable t
@@ -810,33 +811,32 @@ or an empty string if none."
(propertize "\n"
'invisible t
'vc-git-hideable t))))))))
- ;; FIXME: maybe use a different face when nothing is stashed.
(concat
- (propertize "Branch : " 'face 'font-lock-type-face)
+ (propertize "Branch : " 'face 'vc-dir-header)
(propertize branch
- 'face 'font-lock-variable-name-face)
+ 'face 'vc-dir-header-value)
(when remote-url
(concat
"\n"
- (propertize "Remote : " 'face 'font-lock-type-face)
+ (propertize "Remote : " 'face 'vc-dir-header)
(propertize remote-url
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
;; For now just a heading, key bindings can be added later for various
bisect actions
(when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root
dir)))
- (propertize "\nBisect : in progress" 'face
'font-lock-warning-face))
+ (propertize "\nBisect : in progress" 'face 'vc-dir-status-warning))
(when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root
dir)))
- (propertize "\nRebase : in progress" 'face
'font-lock-warning-face))
+ (propertize "\nRebase : in progress" 'face 'vc-dir-status-warning))
(if stash-list
(concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
+ (propertize "\nStash : " 'face 'vc-dir-header)
stash-button
stash-string)
(concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
+ (propertize "\nStash : " 'face 'vc-dir-header)
(propertize "Nothing stashed"
'help-echo vc-git-stash-shared-help
'keymap vc-git-stash-shared-map
- 'face 'font-lock-variable-name-face))))))
+ 'face 'vc-dir-header-value))))))
(defun vc-git-branches ()
"Return the existing branches, as a list of strings.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1d163a6..adb0fce 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"."
(cons (capitalize (match-string 1)) (match-string
2))
(cons "" (buffer-substring (point)
(line-end-position))))))
(concat
- (propertize (format "%-11s: " (car entry)) 'face
'font-lock-type-face)
- (propertize (cdr entry) 'face 'font-lock-variable-name-face)))
+ (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header)
+ (propertize (cdr entry) 'face 'vc-dir-header-value)))
result)
(forward-line))
(nreverse result))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index da54711..22becc9 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory
DIR."
(concat
(cond (repo
(concat
- (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t "")))))
(defun vc-svn-working-revision (file)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 9ef2da7..2548fa4 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -255,6 +255,7 @@ bit output with no translation."
(w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592)
(w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593)
(w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594)
+ (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596)
(w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597)
(w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255)
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 92ed6ee..cfd9876 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -9768,6 +9768,19 @@ With plain \\[universal-argument], move current line to
window center."
(define-key global-map [?\C-l] 'recenter-top-bottom)
+(defun recenter-other-window (&optional arg)
+ "Call `recenter-top-bottom' in the other window.
+
+A prefix argument is handled like `recenter':
+ With numeric prefix ARG, move current line to window-line ARG.
+ With plain `C-u', move current line to window center."
+ (interactive "P")
+ (with-selected-window (other-window-for-scrolling)
+ (recenter-top-bottom arg)
+ (pulse-momentary-highlight-one-line (point))))
+
+(define-key global-map [?\S-\M-\C-l] 'recenter-other-window)
+
(defun move-to-window-line-top-bottom (&optional arg)
"Position point relative to window.
@@ -10239,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/lisp/woman.el b/lisp/woman.el
index 9a03d30..98f1a47 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -69,13 +69,7 @@
;; Recommended use
;; ===============
-;; Put this in your .emacs:
-;; (autoload 'woman "woman"
-;; "Decode and browse a UN*X man page." t)
-;; (autoload 'woman-find-file "woman"
-;; "Find, decode and browse a specific UN*X man-page file." t)
-
-;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment
+;; Either (1 -- *RECOMMENDED*): If the `MANPATH' environment
;; variable is set then WoMan will use it; otherwise you may need to
;; reset the Lisp variable `woman-manpath', and you may also want to
;; set the Lisp variable `woman-path'. Please see the online
@@ -139,14 +133,8 @@
;; ==============================
;; WoMan supports the GNU Emacs customization facility, and puts
-;; a customization group called `WoMan' in the `Help' group under the
-;; top-level `Emacs' group. In order to be able to customize WoMan
-;; without first loading it, add the following sexp to your .emacs:
-
-;; (defgroup woman nil
-;; "Browse UNIX manual pages `wo (without) man'."
-;; :tag "WoMan" :group 'help :load "woman")
-
+;; a customization group called `woman' in the `help' group under the
+;; top-level `emacs' group.
;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately
;; before formatting a buffer and `woman-post-format-hook' immediately
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/callproc.c b/src/callproc.c
index cb72b07..cd0f67f 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -411,7 +411,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
/* If the buffer is (still) a list, it might be a (:file "file") spec. */
if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
{
- output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
+ Lisp_Object ofile = XCDR (buffer);
+ if (CONSP (ofile))
+ ofile = XCAR (ofile);
+ CHECK_STRING (ofile);
+ output_file = Fexpand_file_name (ofile,
BVAR (current_buffer, directory));
CHECK_STRING (output_file);
buffer = Qnil;
diff --git a/src/data.c b/src/data.c
index 38cde0f..ace859d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -904,7 +904,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))
@@ -920,10 +930,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;
}
@@ -3908,6 +3983,7 @@ syms_of_data (void)
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
+ defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
@@ -4030,6 +4106,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/dispnew.c b/src/dispnew.c
index 55667fa..0b64ea6 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3328,7 +3328,7 @@ update_frame_with_menu (struct frame *f, int row, int col)
}
/* Update the mouse position for a frame F. This handles both
- updating the display for mouse-face propreties and updating the
+ updating the display for mouse-face properties and updating the
help echo text.
Returns the number of events generated. */
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 3aff3b5..542d7f6 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1165,21 +1165,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))
@@ -1194,22 +1196,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;
}
@@ -2084,14 +2080,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/filelock.c b/src/filelock.c
index 35baa0c..373fc00 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -532,7 +532,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
/* If nonexistent lock file, all is well; otherwise, got strange error. */
lfinfolen = read_lock_data (lfname, owner->user);
if (lfinfolen < 0)
- return errno == ENOENT ? 0 : errno;
+ return errno == ENOENT || errno == ENOTDIR ? 0 : errno;
if (MAX_LFINFO < lfinfolen)
return ENAMETOOLONG;
owner->user[lfinfolen] = 0;
diff --git a/src/fns.c b/src/fns.c
index bd4afa0..c16f9c6 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5758,6 +5758,38 @@ in OBJECT. */)
traverse_intervals (intervals, 0, collect_interval, collector);
return CDR (collector);
}
+
+DEFUN ("line-number-at-pos", Fline_number_at_pos,
+ Sline_number_at_pos, 0, 2, 0,
+ doc: /* Return the line number at POSITION.
+If POSITION is nil, use the current buffer location.
+
+If the buffer is narrowed, the position returned is the position in the
+visible part of the buffer. If ABSOLUTE is non-nil, count the lines
+from the absolute start of the buffer. */)
+ (register Lisp_Object position, Lisp_Object absolute)
+{
+ ptrdiff_t pos, start = BEGV_BYTE;
+
+ if (MARKERP (position))
+ pos = marker_position (position);
+ else if (NILP (position))
+ pos = PT;
+ else
+ {
+ CHECK_FIXNUM (position);
+ pos = XFIXNUM (position);
+ }
+
+ if (!NILP (absolute))
+ start = BEG_BYTE;
+
+ /* Check that POSITION is n the visible range of the buffer. */
+ if (pos < BEGV || pos > ZV)
+ args_out_of_range (make_int (start), make_int (ZV));
+
+ return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1);
+}
void
@@ -5800,6 +5832,7 @@ syms_of_fns (void)
defsubr (&Sdefine_hash_table_test);
defsubr (&Sstring_search);
defsubr (&Sobject_intervals);
+ defsubr (&Sline_number_at_pos);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");
diff --git a/src/font.c b/src/font.c
index ce3f4c6..cdf35b0 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4122,7 +4122,7 @@ representing the OpenType features supported by the font
by this form:
SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
Layout tags.
-In addition to the keys listed abobe, the following keys are reserved
+In addition to the keys listed above, the following keys are reserved
for the specific meanings as below:
The value of :combining-capability is non-nil if the font-backend of
diff --git a/src/frame.c b/src/frame.c
index a3e44c7..c1ab344 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -900,6 +900,7 @@ make_frame (bool mini_p)
f->no_accept_focus = false;
f->z_group = z_group_none;
f->tooltip = false;
+ f->child_frame_border_width = -1;
f->last_tab_bar_item = -1;
#ifndef HAVE_EXT_TOOL_BAR
f->last_tool_bar_item = -1;
@@ -3547,10 +3548,17 @@ DEFUN ("frame-fringe-width", Ffringe_width,
Sfringe_width, 0, 1, 0,
}
DEFUN ("frame-child-frame-border-width", Fframe_child_frame_border_width,
Sframe_child_frame_border_width, 0, 1, 0,
- doc: /* Return width of FRAME's child-frame border in pixels. */)
+ doc: /* Return width of FRAME's child-frame border in pixels.
+ If FRAME's 'child-frame-border-width' parameter is nil, return FRAME's
+ internal border width instead. */)
(Lisp_Object frame)
{
- return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame
(frame)));
+ int width = FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame (frame));
+
+ if (width < 0)
+ return make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame
(frame)));
+ else
+ return make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (decode_any_frame
(frame)));
}
DEFUN ("frame-internal-border-width", Fframe_internal_border_width,
Sframe_internal_border_width, 0, 1, 0,
@@ -3885,7 +3893,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. */
@@ -4314,7 +4322,9 @@ gui_report_frame_params (struct frame *f, Lisp_Object
*alistptr)
store_in_alist (alistptr, Qborder_width,
make_fixnum (f->border_width));
store_in_alist (alistptr, Qchild_frame_border_width,
- make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f)));
+ FRAME_CHILD_FRAME_BORDER_WIDTH (f) >= 0
+ ? make_fixnum (FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ : Qnil);
store_in_alist (alistptr, Qinternal_border_width,
make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)));
store_in_alist (alistptr, Qright_divider_width,
@@ -5894,7 +5904,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/frame.h b/src/frame.h
index 47ee6a8..bb05448 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1458,11 +1458,11 @@ INLINE int
FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
{
#ifdef HAVE_WINDOW_SYSTEM
- return FRAME_PARENT_FRAME(f)
- ? (f->child_frame_border_width
- ? FRAME_CHILD_FRAME_BORDER_WIDTH(f)
- : frame_dimension (f->internal_border_width))
- : frame_dimension (f->internal_border_width);
+ return (FRAME_PARENT_FRAME(f)
+ ? (FRAME_CHILD_FRAME_BORDER_WIDTH(f) >= 0
+ ? FRAME_CHILD_FRAME_BORDER_WIDTH(f)
+ : frame_dimension (f->internal_border_width))
+ : frame_dimension (f->internal_border_width));
#else
return frame_dimension (f->internal_border_width);
#endif
diff --git a/src/image.c b/src/image.c
index 09370fa..62bca41 100644
--- a/src/image.c
+++ b/src/image.c
@@ -150,6 +150,12 @@ typedef struct pgtk_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);
@@ -2330,8 +2336,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
@@ -10148,6 +10154,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/indent.c b/src/indent.c
index 0a6b460..6246b54 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1315,7 +1315,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
j ^---- next after the point
^--- next char. after the point.
----------
- In case of sigle-column character
+ In case of single-column character
----------
abcdefgh\\
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 409a1e7..b95f389 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4091,6 +4091,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;
@@ -4220,6 +4221,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 *);
@@ -4369,6 +4372,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/lread.c b/src/lread.c
index 010194c..dea1b23 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4833,7 +4833,8 @@ to find all the symbols in an obarray, use `mapatoms'.
*/);
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read,
evaluated and printed.
-Order is reverse chronological. */);
+Order is reverse chronological.
+This variable is obsolete as of Emacs 28.1 and should not be used. */);
XSYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
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/nsfns.m b/src/nsfns.m
index c7857ea..5c4cc91 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -690,17 +690,24 @@ ns_set_tool_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
static void
ns_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
- int old_width = FRAME_CHILD_FRAME_BORDER_WIDTH (f);
- int new_width = check_int_nonnegative (arg);
+ int border;
- if (new_width == old_width)
- return;
- f->child_frame_border_width = new_width;
+ if (NILP (arg))
+ border = -1;
+ else if (RANGED_FIXNUMP (0, arg, INT_MAX))
+ border = XFIXNAT (arg);
+ else
+ signal_error ("Invalid child frame border width", arg);
- if (FRAME_NATIVE_WINDOW (f) != 0)
- adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width);
+ if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ {
+ f->child_frame_border_width = border;
- SET_FRAME_GARBAGED (f);
+ if (FRAME_NATIVE_WINDOW (f) != 0)
+ adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width);
+
+ SET_FRAME_GARBAGED (f);
+ }
}
static void
@@ -1213,7 +1220,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2),
"internalBorderWidth", "InternalBorderWidth",
RES_TYPE_NUMBER);
- gui_default_parameter (f, parms, Qchild_frame_border_width, make_fixnum (2),
+ gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil,
"childFrameBorderWidth", "childFrameBorderWidth",
RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0),
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..6551694 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
@@ -8354,6 +8377,11 @@ not_in_argv (NSString *arg)
surface = [[EmacsSurface alloc] initWithSize:s
ColorSpace:[[[self window] colorSpace]
CGColorSpace]];
+
+ /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay
+ the layer's scale factor is not set automatically, so do it
+ now. */
+ [[self layer] setContentsScale:[[self window] backingScaleFactor]];
}
CGContextRef context = [surface getContext];
@@ -8452,6 +8480,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 +8525,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 c1388eb..337742f 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2692,7 +2692,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;
@@ -2703,6 +2703,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/process.c b/src/process.c
index 5ac0d20..dbf8552 100644
--- a/src/process.c
+++ b/src/process.c
@@ -8259,7 +8259,7 @@ init_process_emacs (int sockfd)
private SIGCHLD handler, allowing catch_child_signal to copy
it into lib_child_handler.
- Unfortunatly in glib commit 2e471acf, the behavior changed to
+ Unfortunately in glib commit 2e471acf, the behavior changed to
always install a signal handler when g_child_watch_source_new
is called and not just the first time it's called. Glib also
now resets signal handlers to SIG_DFL when it no longer has a
diff --git a/src/w32.c b/src/w32.c
index a3c247b..aade802 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -346,6 +346,7 @@ static BOOL g_b_init_get_adapters_addresses;
static BOOL g_b_init_reg_open_key_ex_w;
static BOOL g_b_init_reg_query_value_ex_w;
static BOOL g_b_init_expand_environment_strings_w;
+static BOOL g_b_init_get_user_default_ui_language;
BOOL g_b_init_compare_string_w;
BOOL g_b_init_debug_break_process;
@@ -533,6 +534,7 @@ DWORD multiByteToWideCharFlags;
typedef LONG (WINAPI *RegOpenKeyExW_Proc) (HKEY,LPCWSTR,DWORD,REGSAM,PHKEY);
typedef LONG (WINAPI *RegQueryValueExW_Proc)
(HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYTE,LPDWORD);
typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD);
+typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void);
/* ** A utility function ** */
static BOOL
@@ -1489,6 +1491,28 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR
lpDst, DWORD nSize)
return s_pfn_Expand_Environment_Strings_w (lpSrc, lpDst, nSize);
}
+static LANGID WINAPI
+get_user_default_ui_language (void)
+{
+ static GetUserDefaultUILanguage_Proc s_pfn_GetUserDefaultUILanguage = NULL;
+ HMODULE hm_kernel32 = NULL;
+
+ if (is_windows_9x () == TRUE)
+ return 0;
+
+ if (g_b_init_get_user_default_ui_language == 0)
+ {
+ g_b_init_get_user_default_ui_language = 1;
+ hm_kernel32 = LoadLibrary ("Kernel32.dll");
+ if (hm_kernel32)
+ s_pfn_GetUserDefaultUILanguage = (GetUserDefaultUILanguage_Proc)
+ get_proc_addr (hm_kernel32, "GetUserDefaultUILanguage");
+ }
+ if (s_pfn_GetUserDefaultUILanguage == NULL)
+ return 0;
+ return s_pfn_GetUserDefaultUILanguage ();
+}
+
/* Return 1 if P is a valid pointer to an object of size SIZE. Return
@@ -2947,6 +2971,32 @@ init_environment (char ** argv)
LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
locale_name, sizeof (locale_name)))
{
+ /* Microsoft are migrating away of locale IDs, replacing them
+ with locale names, such as "en-US", and are therefore
+ deprecating the APIs which use LCID etc. As part of that
+ deprecation, they don't bother inventing LCID and LANGID
+ codes for new locales and language/culture combinations;
+ instead, those get LCID of 0xC000 and LANGID of 0x2000, for
+ which the LCID/LANGID oriented APIs return "ZZZ" as the
+ "language name". Such "language name" is useless for our
+ purposes. So we instead use the default UI language, in the
+ hope of getting something usable. */
+ if (strcmp (locale_name, "ZZZ") == 0)
+ {
+ LANGID lang_id = get_user_default_ui_language ();
+
+ if (lang_id != 0)
+ {
+ /* Disregard the sorting order differences between cultures. */
+ LCID def_lcid = MAKELCID (lang_id, SORT_DEFAULT);
+ char locale_name_def[32];
+
+ if (GetLocaleInfo (def_lcid,
+ LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
+ locale_name_def, sizeof (locale_name_def)))
+ strcpy (locale_name, locale_name_def);
+ }
+ }
for (i = 0; i < N_ENV_VARS; i++)
{
if (strcmp (env_vars[i].name, "LANG") == 0)
@@ -10580,6 +10630,7 @@ globals_of_w32 (void)
g_b_init_expand_environment_strings_w = 0;
g_b_init_compare_string_w = 0;
g_b_init_debug_break_process = 0;
+ g_b_init_get_user_default_ui_language = 0;
num_of_processors = 0;
/* The following sets a handler for shutdown notifications for
console apps. This actually applies to Emacs in both console and
diff --git a/src/w32fns.c b/src/w32fns.c
index 5704f1d..9db367b 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1561,8 +1561,14 @@ w32_clear_under_internal_border (struct frame *f)
static void
w32_set_child_frame_border_width (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
- int argval = check_integer_range (arg, INT_MIN, INT_MAX);
- int border = max (argval, 0);
+ int border;
+
+ if (NILP (arg))
+ border = -1;
+ else if (RANGED_FIXNUMP (0, arg, INT_MAX))
+ border = XFIXNAT (arg);
+ else
+ signal_error ("Invalid child frame border width", arg);
if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
{
@@ -3887,7 +3893,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg,
UINT wParam,
Essentially, we have no information about the "role" of
modifiers on this key: which contribute into the
produced character (so "are consumed"), and which are
- "extra" (must attache to bindable events).
+ "extra" (must attach to bindable events).
The default above would consume ALL modifiers, so the
character is reported "as is". However, on many layouts
@@ -5896,37 +5902,33 @@ DEFUN ("x-create-frame", Fx_create_frame,
Sx_create_frame,
Lisp_Object value;
value = gui_display_get_arg (dpyinfo, parameters, Qinternal_border_width,
- "internalBorder", "InternalBorder",
+ "internalBorder", "internalBorder",
RES_TYPE_NUMBER);
if (! EQ (value, Qunbound))
parameters = Fcons (Fcons (Qinternal_border_width, value),
parameters);
}
+ gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum
(0),
+ "internalBorderWidth", "internalBorderWidth",
+ RES_TYPE_NUMBER);
+
/* Same for child frames. */
if (NILP (Fassq (Qchild_frame_border_width, parameters)))
{
Lisp_Object value;
value = gui_display_get_arg (dpyinfo, parameters,
Qchild_frame_border_width,
- "childFrameBorderWidth",
"childFrameBorderWidth",
+ "childFrameBorder", "childFrameBorder",
RES_TYPE_NUMBER);
- if (! EQ (value, Qunbound))
+ if (!EQ (value, Qunbound))
parameters = Fcons (Fcons (Qchild_frame_border_width, value),
parameters);
-
}
- gui_default_parameter (f, parameters, Qchild_frame_border_width,
-#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
- make_fixnum (0),
-#else
- make_fixnum (1),
-#endif
+ gui_default_parameter (f, parameters, Qchild_frame_border_width, Qnil,
"childFrameBorderWidth", "childFrameBorderWidth",
RES_TYPE_NUMBER);
- gui_default_parameter (f, parameters, Qinternal_border_width, make_fixnum
(0),
- "internalBorderWidth", "InternalBorder",
RES_TYPE_NUMBER);
gui_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0),
NULL, NULL, RES_TYPE_NUMBER);
gui_default_parameter (f, parameters, Qbottom_divider_width, make_fixnum (0),
diff --git a/src/window.h b/src/window.h
index 4271fc8..4f209f3 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 1705460..d37a565 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;
@@ -19452,8 +19455,11 @@ try_window (Lisp_Object window, struct text_pos pos,
int flags)
'start_display' again. */
ptrdiff_t it_charpos = IT_CHARPOS (it);
- /* Don't let the cursor end in the scroll margins. */
+ /* Don't let the cursor end in the scroll margins. However, when
+ the window is vscrolled, we leave it to vscroll to handle the
+ margins, see window_scroll_pixel_based. */
if ((flags & TRY_WINDOW_CHECK_MARGINS)
+ && w->vscroll == 0
&& !MINI_WINDOW_P (w))
{
int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
@@ -19462,7 +19468,7 @@ try_window (Lisp_Object window, struct text_pos pos,
int flags)
top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
start_display (&it, w, pos);
- if ((w->cursor.y >= 0 /* not vscrolled */
+ if ((w->cursor.y >= 0
&& w->cursor.y < top_scroll_margin
&& CHARPOS (pos) > BEGV)
/* rms: considering make_cursor_line_fully_visible_p here
diff --git a/src/xfaces.c b/src/xfaces.c
index b3960fb..dde611e 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -293,7 +293,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Size of hash table of realized faces in face caches (should be a
prime number). */
-#define FACE_CACHE_BUCKETS_SIZE 1001
+#define FACE_CACHE_BUCKETS_SIZE 1009
char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
diff --git a/src/xfns.c b/src/xfns.c
index cac41ee..d906448 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1803,7 +1803,14 @@ x_change_tool_bar_height (struct frame *f, int height)
static void
x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object
oldval)
{
- int border = check_int_nonnegative (arg);
+ int border;
+
+ if (NILP (arg))
+ border = -1;
+ else if (RANGED_FIXNUMP (0, arg, INT_MAX))
+ border = XFIXNAT (arg);
+ else
+ signal_error ("Invalid child frame border width", arg);
if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
{
@@ -3920,36 +3927,31 @@ This function is an internal primitive--use
`make-frame' instead. */)
parms);
}
+ gui_default_parameter (f, parms, Qinternal_border_width,
+#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
+ make_fixnum (0),
+#else
+ make_fixnum (1),
+#endif
+ "internalBorderWidth", "internalBorderWidth",
+ RES_TYPE_NUMBER);
+
/* Same for child frames. */
if (NILP (Fassq (Qchild_frame_border_width, parms)))
{
Lisp_Object value;
value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width,
- "childFrameBorderWidth",
"childFrameBorderWidth",
+ "childFrameBorder", "childFrameBorder",
RES_TYPE_NUMBER);
if (! EQ (value, Qunbound))
parms = Fcons (Fcons (Qchild_frame_border_width, value),
parms);
-
}
- gui_default_parameter (f, parms, Qchild_frame_border_width,
-#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
- make_fixnum (0),
-#else
- make_fixnum (1),
-#endif
+ gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil,
"childFrameBorderWidth", "childFrameBorderWidth",
RES_TYPE_NUMBER);
- gui_default_parameter (f, parms, Qinternal_border_width,
-#ifdef USE_GTK /* We used to impose 0 in xg_create_frame_widgets. */
- make_fixnum (0),
-#else
- make_fixnum (1),
-#endif
- "internalBorderWidth", "internalBorderWidth",
- RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0),
NULL, NULL, RES_TYPE_NUMBER);
gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0),
@@ -4597,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
@@ -4660,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
@@ -4875,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/Makefile.in b/test/Makefile.in
index f907602..ff228d1 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -71,6 +71,15 @@ am__v_at_0 = @
am__v_at_1 =
+# Load any GNU ELPA dependencies that are present, for optional tests.
+GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa
+# Keep elpa_dependencies dependency-ordered.
+elpa_dependencies = \
+ url-http-ntlm/url-http-ntlm.el \
+ web-server/web-server.el
+elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies))
+elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el))
-l $(el)))
+
# We never change directory before running Emacs, so a relative file
# name is fine, and makes life easier. If we need to change
# directory, we can use emacs --chdir.
@@ -81,7 +90,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L
"$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L
"$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
@@ -105,7 +114,7 @@ export TEST_LOAD_EL ?= \
$(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes)
# Additional settings for ert.
-ert_opts =
+ert_opts += $(elpa_opts)
# Maximum length of lines in ert backtraces; nil for no limit.
# (if empty, use the default ert-batch-backtrace-right-margin).
diff --git a/test/README b/test/README
index 5f3c10a..1e0e43a 100644
--- a/test/README
+++ b/test/README
@@ -106,8 +106,13 @@ tramp-tests.el). Per default, a mock-up connection method
is used
to test a real remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY
to a suitable value in order to overwrite the default value:
- env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+ env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+Some optional tests require packages from GNU ELPA. By default
+../../elpa will be checked for these packages. If GNU ELPA is checked
+out somewhere else, use
+
+ make GNU_ELPA_DIRECTORY=/path/to/elpa ...
There are also continuous integration tests on
<https://hydra.nixos.org/jobset/gnu/emacs-trunk> (see
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/cedet/cedet-files-tests.el
b/test/lisp/cedet/cedet-files-tests.el
new file mode 100644
index 0000000..5502d42
--- /dev/null
+++ b/test/lisp/cedet/cedet-files-tests.el
@@ -0,0 +1,54 @@
+;;; cedet-files-tests.el --- Tests for cedet-files.el -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'cedet-files)
+
+(defvar cedet-files-utest-list
+ '(
+ ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
+ ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
+ ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
+ ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
+ )
+ "List of different file names to test.
+Each entry is a cons cell of ( FNAME . CONVERTED )
+where FNAME is some file name, and CONVERTED is what it should be
+converted into.")
+
+(ert-deftest cedet-files-utest ()
+ "Test out some file name conversions."
+ (interactive)
+ (dolist (FT cedet-files-utest-list)
+ (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
+ (file->dir (cedet-file-name-to-directory-name (cdr FT) t)))
+ (should (string= (cdr FT) dir->file))
+ (should (string= file->dir (car FT))))))
+
+(provide 'cedet-files-tests)
+
+;;; cedet-files-tests.el ends here
diff --git a/test/lisp/cedet/inversion-tests.el
b/test/lisp/cedet/inversion-tests.el
new file mode 100644
index 0000000..c8b45d6
--- /dev/null
+++ b/test/lisp/cedet/inversion-tests.el
@@ -0,0 +1,81 @@
+;;; inversion-tests.el --- Tests for inversion.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'inversion)
+(require 'ert)
+
+(ert-deftest inversion-unit-test ()
+ "Test inversion to make sure it can identify different version strings."
+ (interactive)
+ (let ((c1 (inversion-package-version 'inversion))
+ (c1i (inversion-package-incompatibility-version 'inversion))
+ (c2 (inversion-decode-version "1.3alpha2"))
+ (c3 (inversion-decode-version "1.3beta4"))
+ (c4 (inversion-decode-version "1.3 beta5"))
+ (c5 (inversion-decode-version "1.3.4"))
+ (c6 (inversion-decode-version "2.3alpha"))
+ (c7 (inversion-decode-version "1.3"))
+ (c8 (inversion-decode-version "1.3pre1"))
+ (c9 (inversion-decode-version "2.4 (patch 2)"))
+ (c10 (inversion-decode-version "2.4 (patch 3)"))
+ (c11 (inversion-decode-version "2.4.2.1"))
+ (c12 (inversion-decode-version "2.4.2.2")))
+ (should (inversion-= c1 c1))
+ (should (inversion-< c1i c1))
+ (should (inversion-< c2 c3))
+ (should (inversion-< c3 c4))
+ (should (inversion-< c4 c5))
+ (should (inversion-< c5 c6))
+ (should (inversion-< c2 c4))
+ (should (inversion-< c2 c5))
+ (should (inversion-< c2 c6))
+ (should (inversion-< c3 c5))
+ (should (inversion-< c3 c6))
+ (should (inversion-< c7 c6))
+ (should (inversion-< c4 c7))
+ (should (inversion-< c2 c7))
+ (should (inversion-< c8 c6))
+ (should (inversion-< c8 c7))
+ (should (inversion-< c4 c8))
+ (should (inversion-< c2 c8))
+ (should (inversion-< c9 c10))
+ (should (inversion-< c10 c11))
+ (should (inversion-< c11 c12))
+ ;; Negatives
+ (should-not (inversion-< c3 c2))
+ (should-not (inversion-< c4 c3))
+ (should-not (inversion-< c5 c4))
+ (should-not (inversion-< c6 c5))
+ (should-not (inversion-< c7 c2))
+ (should-not (inversion-< c7 c8))
+ (should-not (inversion-< c12 c11))
+ ;; Test the tester on inversion
+ (should-not (inversion-test 'inversion inversion-version))
+ (should (stringp (inversion-test 'inversion "0.0.0")))
+ (should (stringp (inversion-test 'inversion "1000.0")))))
+
+;;; inversion-tests.el ends here
diff --git a/test/lisp/cedet/semantic-utest-fmt.el
b/test/lisp/cedet/semantic-utest-fmt.el
deleted file mode 100644
index d6e5ce7..0000000
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ /dev/null
@@ -1,127 +0,0 @@
-;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*-
lexical-binding:t -*-
-
-;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Unit tests for the formatting feature.
-;;
-;; Using test code from the tests source directory, parse the source
-;; file. After parsing, read the comments for each signature, and
-;; make sure that the semantic-tag-format-* functions in question
-;; created the desired output.
-
-(require 'semantic)
-(require 'semantic/format)
-
-;;; Code:
-
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-fmt-utest-file-list
- '("tests/test-fmt.cpp"
- ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
- )
- "List of files to run unit tests in.")
-
-(defvar semantic-fmt-utest-error-log-list nil
- "Log errors during testing in this variable.")
-
-(ert-deftest semantic-fmt-utest ()
- "Visit all file entries, and run formatting test.
-Files to visit are in `semantic-fmt-utest-file-list'."
- (save-current-buffer
- (semantic-mode 1)
- (let ((fl semantic-fmt-utest-file-list)
- (fname nil)
- )
-
- (dolist (FILE fl)
-
- (save-current-buffer
- (setq fname (expand-file-name FILE cedet-utest-directory))
-
- ;; Make sure we have the files we think we have.
- (should (file-exists-p fname))
- ;; (error "Cannot find unit test file: %s" fname))
-
- ;; Run the tests.
- (let ((fb (find-buffer-visiting fname))
- (b (semantic-find-file-noselect fname))
- (tags nil))
-
- (save-current-buffer
- (set-buffer b)
- (should (semantic-active-p))
- ;;(error "Cannot open %s for format tests" fname))
-
- ;; This will force a reparse, removing any chance of semanticdb
cache
- ;; using stale data.
- (semantic-clear-toplevel-cache)
- ;; Force the reparse
- (setq tags (semantic-fetch-tags))
-
- (save-excursion
- (while tags
- (let* ((T (car tags))
- (start (semantic-tag-end T))
- (end (if (cdr tags)
- (semantic-tag-start (car (cdr tags)))
- (point-max)))
- (TESTS nil)
- )
- (goto-char start)
- ;; Scan the space between tags for all test condition
matches.
- (while (re-search-forward "## \\([a-z-]+\\)
\"\\([^\n\"]+\\)\"$" end t)
- (push (cons (match-string 1) (match-string 2)) TESTS))
- (setq TESTS (nreverse TESTS))
-
- (dolist (TST TESTS)
- (let* ( ;; For each test, convert CAR into a
semantic-format-tag* fcn
- (sym (intern (concat "semantic-format-tag-" (car
TST))))
- ;; Convert the desired result from a string syntax
to a string.
- (desired (cdr TST))
- ;; What does the fmt function do?
- (actual (funcall sym T))
- )
- (when (not (string= desired actual))
- (should-not (list "Desired" desired
- "Actual" actual
- "Formatter" (car TST))))
- )))
- (setq tags (cdr tags)))
-
- ))
-
- ;; If it wasn't already in memory, whack it.
- (when (and b (not fb))
- (kill-buffer b)))
- ))
-
- )))
-
-
-(provide 'cedet/semantic/fmt-utest)
-
-;;; semantic-fmt-utest.el ends here
diff --git a/test/manual/cedet/tests/test.mk
b/test/lisp/cedet/semantic-utest-ia-resources/test.mk
similarity index 100%
rename from test/manual/cedet/tests/test.mk
rename to test/lisp/cedet/semantic-utest-ia-resources/test.mk
diff --git a/test/manual/cedet/tests/test.srt
b/test/lisp/cedet/semantic-utest-ia-resources/test.srt
similarity index 100%
rename from test/manual/cedet/tests/test.srt
rename to test/lisp/cedet/semantic-utest-ia-resources/test.srt
diff --git a/test/manual/cedet/tests/test.texi
b/test/lisp/cedet/semantic-utest-ia-resources/test.texi
similarity index 100%
rename from test/manual/cedet/tests/test.texi
rename to test/lisp/cedet/semantic-utest-ia-resources/test.texi
diff --git a/test/manual/cedet/tests/testdoublens.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
similarity index 100%
rename from test/manual/cedet/tests/testdoublens.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
diff --git a/test/manual/cedet/tests/testdoublens.hpp
b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
similarity index 100%
rename from test/manual/cedet/tests/testdoublens.hpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
diff --git a/test/manual/cedet/tests/testfriends.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
similarity index 99%
rename from test/manual/cedet/tests/testfriends.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
index 20425f9..f84ed5a 100644
--- a/test/manual/cedet/tests/testfriends.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
@@ -35,4 +35,3 @@ int B::testB() {
int B::testAB() { // %1% ( ( "testfriends.cpp" ) ( "B" "B::testAB" ) )
}
-
diff --git a/test/manual/cedet/tests/testjavacomp.java
b/test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
similarity index 100%
rename from test/manual/cedet/tests/testjavacomp.java
rename to test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
diff --git a/test/manual/cedet/tests/testlocalvars.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
similarity index 100%
rename from test/manual/cedet/tests/testlocalvars.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
diff --git a/test/manual/cedet/tests/testnsp.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
similarity index 100%
rename from test/manual/cedet/tests/testnsp.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
diff --git a/test/manual/cedet/tests/testsppcomplete.c
b/test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
similarity index 100%
rename from test/manual/cedet/tests/testsppcomplete.c
rename to test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
diff --git a/test/manual/cedet/tests/teststruct.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
similarity index 100%
rename from test/manual/cedet/tests/teststruct.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
diff --git a/test/manual/cedet/tests/testsubclass.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
similarity index 100%
rename from test/manual/cedet/tests/testsubclass.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
diff --git a/test/manual/cedet/tests/testsubclass.hh
b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
similarity index 100%
rename from test/manual/cedet/tests/testsubclass.hh
rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
diff --git a/test/manual/cedet/tests/testtemplates.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
similarity index 100%
rename from test/manual/cedet/tests/testtemplates.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
diff --git a/test/manual/cedet/tests/testtypedefs.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
similarity index 100%
rename from test/manual/cedet/tests/testtypedefs.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
diff --git a/test/manual/cedet/tests/testusing.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
similarity index 100%
rename from test/manual/cedet/tests/testusing.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
diff --git a/test/manual/cedet/tests/testusing.hh
b/test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
similarity index 100%
rename from test/manual/cedet/tests/testusing.hh
rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
diff --git a/test/manual/cedet/tests/testvarnames.c
b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
similarity index 100%
rename from test/manual/cedet/tests/testvarnames.c
rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
diff --git a/test/manual/cedet/tests/testvarnames.java
b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
similarity index 100%
rename from test/manual/cedet/tests/testvarnames.java
rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
diff --git a/test/manual/cedet/tests/testwisent.wy
b/test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
similarity index 100%
rename from test/manual/cedet/tests/testwisent.wy
rename to test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
diff --git a/test/lisp/cedet/semantic-utest-ia.el
b/test/lisp/cedet/semantic-utest-ia.el
index 7210f66..122c431 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -30,121 +30,94 @@
;; (Replace // with contents of comment-start for the language being tested.)
;;; Code:
+(require 'ert)
+(require 'ert-x)
(require 'semantic)
(require 'semantic/analyze)
(require 'semantic/analyze/refs)
(require 'semantic/symref)
(require 'semantic/symref/filter)
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-utest-test-directory (expand-file-name "tests"
cedet-utest-directory)
- "Location of test files.")
-
(ert-deftest semantic-utest-ia-doublens.cpp ()
- (let ((tst (expand-file-name "testdoublens.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testdoublens.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-subclass.cpp ()
- (let ((tst (expand-file-name "testsubclass.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsubclass.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-typedefs.cpp ()
- (let ((tst (expand-file-name "testtypedefs.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtypedefs.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-struct.cpp ()
- (let ((tst (expand-file-name "teststruct.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "teststruct.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-union.cpp ()
-;; (let ((tst (expand-file-name "testunion.cpp"
semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testunion.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-templates.cpp ()
- (let ((tst (expand-file-name "testtemplates.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtemplates.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-friends.cpp ()
-;; (let ((tst (expand-file-name "testfriends.cpp"
semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testfriends.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-using.cpp ()
- (let ((tst (expand-file-name "testusing.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testusing.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-nsp.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-localvars.cpp ()
- (let ((tst (expand-file-name "testlocalvars.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testlocalvars.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-namespace.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-sppcomplete.c ()
- (let ((tst (expand-file-name "testsppcomplete.c"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsppcomplete.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.c ()
- (let ((tst (expand-file-name "testvarnames.c"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-javacomp.java ()
- (let ((tst (expand-file-name "testjavacomp.java"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testjavacomp.java")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.java ()
- (let ((tst (expand-file-name "testvarnames.java"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.java")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-f90.f90 ()
-;; (let ((tst (expand-file-name "testf90.f90" semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testf90.f90")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-wisent.wy ()
- (let ((tst (expand-file-name "testwisent.wy" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testwisent.wy")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-texi ()
- (let ((tst (expand-file-name "test.texi" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.texi")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-make ()
- (let ((tst (expand-file-name "test.mk" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.mk")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-srecoder ()
- (let ((tst (expand-file-name "test.srt" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.srt")))
(should-not (semantic-ia-utest tst))))
;;; Core testing utility
diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el
b/test/lisp/cedet/semantic/bovine/gcc-tests.el
new file mode 100644
index 0000000..e1a18c6
--- /dev/null
+++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el
@@ -0,0 +1,129 @@
+;;; gcc-tests.el --- Tests for semantic/bovine/gcc.el -*- lexical-binding:t
-*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/bovine/gcc)
+
+;;; From bovine-gcc:
+
+;; Example output of "gcc -v"
+(defvar semantic-gcc-test-strings
+ '(;; My old box:
+ "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--host=i386-redhat-linux
+Thread model: posix
+gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
+ ;; Alex Ott:
+ "Using built-in specs.
+Target: i486-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1'
--with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-chec [...]
+Thread model: posix
+gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
+ ;; My debian box:
+ "Using built-in specs.
+Target: x86_64-unknown-linux-gnu
+Configured with: ../../../sources/gcc/configure
--prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3
--with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr
--enable-languages=c,c++,fortran
--with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as
--with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
+Thread model: posix
+gcc version 4.2.3"
+ ;; My mac:
+ "Using built-in specs.
+Target: i686-apple-darwin8
+Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure
--disable-checking -enable-werror --prefix=/usr --mandir=/share/man
--enable-languages=c,objc,c++,obj-c++
--program-transform-name=/^[cg][^.-]*$/s/$/-4.0/
--with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib
--build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott
--program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
+Thread model: posix
+gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
+ ;; Ubuntu Intrepid
+ "Using built-in specs.
+Target: x86_64-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-checking=release --build [...]
+Thread model: posix
+gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Red Hat EL4
+ "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
+Thread model: posix
+gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
+ ;; Red Hat EL5
+ "Using built-in specs.
+Target: x86_64-redhat-linux
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--enable-checking=release --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-libgcj-multifile
--enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk
--disable-dssi --enable-plugin
--with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic
--host=x86_64-redhat-linux
+Thread model: posix
+gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
+ ;; David Engster's german gcc on ubuntu 4.3
+ "Es werden eingebaute Spezifikationen verwendet.
+Ziel: i486-linux-gnu
+Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-ch [...]
+Thread-Modell: posix
+gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Damien Deville bsd
+ "Using built-in specs.
+Target: i386-undermydesk-freebsd
+Configured with: FreeBSD/i386 system compiler
+Thread model: posix
+gcc version 4.2.1 20070719 [FreeBSD]"
+ )
+ "A bunch of sample gcc -v outputs from different machines.")
+
+(defvar semantic-gcc-test-strings-fail
+ '(;; A really old solaris box I found
+ "Reading specs from
/usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
+gcc version 2.95.2 19991024 (release)"
+ )
+ "A bunch of sample gcc -v outputs that fail to provide the info we want.")
+
+(defun semantic-gcc-test-output-parser ()
+ "Test the output parser against some collected strings."
+ (dolist (S semantic-gcc-test-strings)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc 'target fields))
+ (cdr (assoc '--target fields))
+ (cdr (assoc '--host fields))))
+ (p (cdr (assoc '--prefix fields))))
+ ;; No longer test for prefixes.
+ (when (not (and v h))
+ (let ((strs (split-string S "\n")))
+ (error "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)))))
+ (dolist (S semantic-gcc-test-strings-fail)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc '--host fields))
+ (cdr (assoc 'target fields))))
+ (p (cdr (assoc '--prefix fields)))
+ )
+ (when (and v h p)
+ (error "Negative test failed on %S" S)))))
+
+(ert-deftest semantic-gcc-test-output-parser ()
+ (semantic-gcc-test-output-parser))
+
+(ert-deftest semantic-gcc-test-output-parser-this-machine ()
+ "Test the output parser against the machine currently running Emacs."
+ (skip-unless (executable-find "gcc"))
+ (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
+ (semantic-gcc-test-output-parser)))
+
+;;; gcc-tests.el ends here
diff --git a/test/manual/cedet/tests/test-fmt.cpp
b/test/lisp/cedet/semantic/format-resources/test-fmt.cpp
similarity index 100%
rename from test/manual/cedet/tests/test-fmt.cpp
rename to test/lisp/cedet/semantic/format-resources/test-fmt.cpp
diff --git a/test/manual/cedet/tests/test-fmt.el
b/test/lisp/cedet/semantic/format-resources/test-fmt.el
similarity index 95%
rename from test/manual/cedet/tests/test-fmt.el
rename to test/lisp/cedet/semantic/format-resources/test-fmt.el
index 1225713..941aaae 100644
--- a/test/manual/cedet/tests/test-fmt.el
+++ b/test/lisp/cedet/semantic/format-resources/test-fmt.el
@@ -1,4 +1,4 @@
-;;; test-fmt.el --- test semantic tag formatting
+;;; test-fmt.el --- test semantic tag formatting -*- lexical-binding: t -*-
;;; Copyright (C) 2012, 2019-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/cedet/semantic/format-tests.el
b/test/lisp/cedet/semantic/format-tests.el
new file mode 100644
index 0000000..e82c97b
--- /dev/null
+++ b/test/lisp/cedet/semantic/format-tests.el
@@ -0,0 +1,95 @@
+;;; semantic/format-tests.el --- Parsing / Formatting tests -*-
lexical-binding:t -*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for the formatting feature.
+;;
+;; Using test code from the tests source directory, parse the source
+;; file. After parsing, read the comments for each signature, and
+;; make sure that the semantic-tag-format-* functions in question
+;; created the desired output.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'semantic/format)
+
+(defvar semantic-fmt-utest-file-list
+ (list (ert-resource-file "test-fmt.cpp")
+ ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
+ )
+ "List of files to run unit tests in.")
+
+(ert-deftest semantic-fmt-utest ()
+ "Visit all file entries, and run formatting test. "
+ (save-current-buffer
+ (semantic-mode 1)
+ (dolist (fname semantic-fmt-utest-file-list)
+ (let ((fb (find-buffer-visiting fname))
+ (b (semantic-find-file-noselect fname))
+ (tags nil))
+ (save-current-buffer
+ (set-buffer b)
+ (should (semantic-active-p))
+ ;;(error "Cannot open %s for format tests" fname))
+
+ ;; This will force a reparse, removing any chance of semanticdb cache
+ ;; using stale data.
+ (semantic-clear-toplevel-cache)
+ ;; Force the reparse
+ (setq tags (semantic-fetch-tags))
+
+ (save-excursion
+ (while tags
+ (let* ((T (car tags))
+ (start (semantic-tag-end T))
+ (end (if (cdr tags)
+ (semantic-tag-start (car (cdr tags)))
+ (point-max)))
+ (TESTS nil))
+ (goto-char start)
+ ;; Scan the space between tags for all test condition matches.
+ (while (re-search-forward "## \\([a-z-]+\\)
\"\\([^\n\"]+\\)\"$" end t)
+ (push (cons (match-string 1) (match-string 2)) TESTS))
+ (setq TESTS (nreverse TESTS))
+
+ (dolist (TST TESTS)
+ (let* ( ;; For each test, convert CAR into a
semantic-format-tag* fcn
+ (sym (intern (concat "semantic-format-tag-" (car
TST))))
+ ;; Convert the desired result from a string syntax to
a string.
+ (desired (cdr TST))
+ ;; What does the fmt function do?
+ (actual (funcall sym T)))
+ (when (not (string= desired actual))
+ (should-not (list "Desired" desired
+ "Actual" actual
+ "Formatter" (car TST)))))))
+ (setq tags (cdr tags)))))
+
+ ;; If it wasn't already in memory, whack it.
+ (when (and b (not fb))
+ (kill-buffer b))))))
+
+(provide 'format-tests)
+
+;;; format-tests.el ends here
diff --git a/test/lisp/cedet/semantic/fw-tests.el
b/test/lisp/cedet/semantic/fw-tests.el
new file mode 100644
index 0000000..62d665d
--- /dev/null
+++ b/test/lisp/cedet/semantic/fw-tests.el
@@ -0,0 +1,45 @@
+;;; fw-tests.el --- Tests for semantic/fw.el -*- lexical-binding:t -*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/fw)
+
+;;; From semantic-fw:
+
+(ert-deftest semantic-test-data-cache ()
+ "Test the data cache."
+ (let ((data '(a b c)))
+ (with-current-buffer (get-buffer-create " *semantic-test-data-cache*")
+ (erase-buffer)
+ (insert "The Moose is Loose")
+ (goto-char (point-min))
+ (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+ data 'moose 'exit-cache-zone)
+ ;; retrieve cached data
+ (should (equal (semantic-get-cache-data 'moose) data)))))
+
+;;; gw-tests.el ends here
diff --git a/test/lisp/cedet/srecode/document-tests.el
b/test/lisp/cedet/srecode/document-tests.el
new file mode 100644
index 0000000..0bc6e10
--- /dev/null
+++ b/test/lisp/cedet/srecode/document-tests.el
@@ -0,0 +1,80 @@
+;;; document-tests.el --- Tests for srecode/document.el -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Extracted from srecode-document.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'srecode/document)
+
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-document-function-comment-extract-test ()
+ "Test old comment extraction.
+Dump out the extracted dictionary."
+ :tags '(:unstable)
+ (interactive)
+
+ (srecode-load-tables-for-mode major-mode)
+ (srecode-load-tables-for-mode major-mode 'document)
+
+ (should (srecode-table))
+ ;; (error "No template table found for mode %s" major-mode)
+
+ (let* ((temp (srecode-template-get-table (srecode-table)
+ "function-comment"
+ "declaration"
+ 'document))
+ (fcn-in (semantic-current-tag)))
+
+ (should temp)
+ ;; (error "No templates for function comments")
+
+ ;; Try to figure out the tag we want to use.
+ (should fcn-in)
+ (should (semantic-tag-of-class-p fcn-in 'function))
+ ;; (error "No tag of class 'function to insert comment for")
+
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex)))
+
+ (should lextok)
+ ;; (error "No comment to attempt an extraction")
+
+ (let ((s (semantic-lex-token-start lextok))
+ (e (semantic-lex-token-end lextok))
+ (extract nil))
+
+ (pulse-momentary-highlight-region s e)
+
+ ;; Extract text from the existing comment.
+ (setq extract (srecode-extract temp s e))
+
+ (with-output-to-temp-buffer "*SRECODE DUMP*"
+ (princ "EXTRACTED DICTIONARY FOR ")
+ (princ (semantic-tag-name fcn-in))
+ (princ "\n--------------------------------------------\n")
+ (srecode-dump extract))))))
+
+;;; document-tests.el ends here
diff --git a/test/manual/cedet/srecode-tests.el
b/test/lisp/cedet/srecode/fields-tests.el
similarity index 75%
rename from test/manual/cedet/srecode-tests.el
rename to test/lisp/cedet/srecode/fields-tests.el
index ebc3261..5f634a5 100644
--- a/test/manual/cedet/srecode-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -1,4 +1,4 @@
-;;; srecode-tests.el --- Some tests for CEDET's srecode
+;;; srecode/fields-tests.el --- Tests for srecode/fields.el -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -21,13 +21,15 @@
;;; Commentary:
-;; Extracted from srecode-fields.el and srecode-document.el in the
-;; CEDET distribution.
+;; Extracted from srecode-fields.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
;;; Code:
;;; From srecode-fields:
+(require 'ert)
(require 'srecode/fields)
(defvar srecode-field-utest-text
@@ -36,13 +38,10 @@
It is filled with some text."
"Text for tests.")
-(defun srecode-field-utest ()
- "Test the srecode field manager."
- (interactive)
- (srecode-field-utest-impl))
-
-(defun srecode-field-utest-impl ()
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-field-utest-impl ()
"Implementation of the SRecode field utest."
+ :tags '(:unstable)
(save-excursion
(find-file "/tmp/srecode-field-test.txt")
@@ -131,15 +130,15 @@ It is filled with some text."
;; Various sizes
(mapc (lambda (T)
- (if (string= (object-name-string T) "Test4")
+ (if (string= (eieio-object-name-string T) "Test4")
(progn
(when (not (srecode-empty-region-p T))
(error "Field %s is not empty"
- (object-name T)))
+ (eieio-object-name T)))
)
(when (not (= (srecode-region-size T) 5))
(error "Calculated size of %s was not 5"
- (object-name T)))))
+ (eieio-object-name T)))))
fields)
;; Make sure things stay up after a 'command'.
@@ -151,21 +150,21 @@ It is filled with some text."
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
(srecode-field-next)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 1 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 1 fields))))
+ (eieio-object-name (nth 1 fields))))
(srecode-field-prev)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
;; Move cursor out of the region and have everything cleaned up.
(goto-char 42)
@@ -176,7 +175,7 @@ It is filled with some text."
(mapc (lambda (T)
(when (slot-boundp T 'overlay)
(error "Overlay did not clear off of field %s"
- (object-name T))))
+ (eieio-object-name T))))
fields)
;; End of LET
@@ -187,8 +186,7 @@ It is filled with some text."
(f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8))
(f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30))
(f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40))
- (reg (srecode-template-inserted-region "REG" :start 4 :end 40))
- )
+ (reg (srecode-template-inserted-region "REG" :start 4 :end 40)))
(srecode-overlaid-activate reg)
(when (not (string= (srecode-overlaid-text f1)
@@ -233,62 +231,8 @@ It is filled with some text."
(error "Linkage Test: tail-insert string on dissimilar fields is now
the same"))
;; Cleanup
- (srecode-delete reg)
- )
-
- (set-buffer-modified-p nil)
-
- (message " All field tests passed.")
- ))
-
-;;; From srecode-document:
-
-(require 'srecode/document)
-
-(defun srecode-document-function-comment-extract-test ()
- "Test old comment extraction.
-Dump out the extracted dictionary."
- (interactive)
-
- (srecode-load-tables-for-mode major-mode)
- (srecode-load-tables-for-mode major-mode 'document)
-
- (if (not (srecode-table))
- (error "No template table found for mode %s" major-mode))
-
- (let* ((temp (srecode-template-get-table (srecode-table)
- "function-comment"
- "declaration"
- 'document))
- (fcn-in (semantic-current-tag)))
-
- (if (not temp)
- (error "No templates for function comments"))
-
- ;; Try to figure out the tag we want to use.
- (when (or (not fcn-in)
- (not (semantic-tag-of-class-p fcn-in 'function)))
- (error "No tag of class 'function to insert comment for"))
-
- (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
- )
-
- (when (not lextok)
- (error "No comment to attempt an extraction"))
-
- (let ((s (semantic-lex-token-start lextok))
- (e (semantic-lex-token-end lextok))
- (extract nil))
-
- (pulse-momentary-highlight-region s e)
-
- ;; Extract text from the existing comment.
- (setq extract (srecode-extract temp s e))
+ (srecode-delete reg))
- (with-output-to-temp-buffer "*SRECODE DUMP*"
- (princ "EXTRACTED DICTIONARY FOR ")
- (princ (semantic-tag-name fcn-in))
- (princ "\n--------------------------------------------\n")
- (srecode-dump extract))))))
+ (set-buffer-modified-p nil)))
-;;; srecode-tests.el ends here
+;;; srecode/fields-tests.el ends here
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
index 95f62e0..97b3349 100644
--- a/test/lisp/cus-edit-tests.el
+++ b/test/lisp/cus-edit-tests.el
@@ -53,9 +53,9 @@
(customize-apropos "cus-edit-tests")
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
-(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
+(ert-deftest cus-edit-tests-customize-changed/hide-obsolete ()
(with-cus-edit-test "*Customize Changed Options*"
- (customize-changed-options "917.2") ; some future version
+ (customize-changed "917.2") ;; Some future version.
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index dbe3a15..0a0d783 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -5,6 +5,8 @@
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
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/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 980b402..0b70c11 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -32,6 +32,15 @@
(require 'bytecomp)
;;; Code:
+(defvar bytecomp-test-var nil)
+
+(defun bytecomp-test-get-var ()
+ bytecomp-test-var)
+
+(defun bytecomp-test-identity (x)
+ "Identity, but hidden from some optimisations."
+ x)
+
(defconst byte-opt-testsuite-arith-data
'(
;; some functional tests
@@ -371,7 +380,57 @@
(assoc 'b '((a 1) (b 2) (c 3)))
(assoc "b" '(("a" 1) ("b" 2) ("c" 3)))
(let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x))
- (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v)))))
+ (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))
+
+ ;; Constprop test cases
+ (let ((a 'alpha) (b (concat "be" "ta")) (c nil) (d t) (e :gamma)
+ (f '(delta epsilon)))
+ (list a b c d e f))
+
+ (let ((x 1) (y (+ 3 4)))
+ (list
+ (let (q (y x) (z y))
+ (if q x (list x y z)))))
+
+ (let* ((x 3) (y (* x 2)) (x (1+ y)))
+ x)
+
+ (let ((x 1) (bytecomp-test-var 2) (y 3))
+ (list x bytecomp-test-var (bytecomp-get-test-var) y))
+
+ (progn
+ (defvar d)
+ (let ((x 'a) (y 'b)) (list x y)))
+
+ (let ((x 2))
+ (list x (setq x 13) (setq x (* x 2)) x))
+
+ (let ((x 'a) (y 'b))
+ (setq y x
+ x (cons 'c y)
+ y x)
+ (list x y))
+
+ (let ((x 3))
+ (let ((y x) z)
+ (setq x 5)
+ (setq y (+ y 8))
+ (setq z (if (bytecomp-test-identity t)
+ (progn
+ (setq x (+ x 1))
+ (list x y))
+ (setq x (+ x 2))
+ (list x y)))
+ (list x y z)))
+
+ (let ((i 1) (s 0) (x 13))
+ (while (< i 5)
+ (setq s (+ s i))
+ (setq i (1+ i)))
+ (list s x i))
+
+ (let ((x 2))
+ (list (or (bytecomp-identity 'a) (setq x 3)) x)))
"List of expression for test.
Each element will be executed by interpreter and with
bytecompiled code, and their results compared.")
@@ -1109,6 +1168,37 @@ mountpoint (Bug#44631)."
(with-demoted-errors "Error cleaning up directory: %s"
(delete-directory directory :recursive)))))
+(defun bytecomp-tests--get-vars ()
+ (list (ignore-errors (symbol-value 'bytecomp-tests--var1))
+ (ignore-errors (symbol-value 'bytecomp-tests--var2))))
+
+(ert-deftest bytecomp-local-defvar ()
+ "Check that local `defvar' declarations work correctly, both
+interpreted and compiled."
+ (let ((lexical-binding t))
+ (let ((fun '(lambda ()
+ (defvar bytecomp-tests--var1)
+ (let ((bytecomp-tests--var1 'a) ; dynamic
+ (bytecomp-tests--var2 'b)) ; still lexical
+ (ignore bytecomp-tests--var2) ; avoid warning
+ (bytecomp-tests--get-vars)))))
+ (should (listp fun)) ; Guard against overzealous refactoring!
+ (should (equal (funcall (eval fun t)) '(a nil)))
+ (should (equal (funcall (byte-compile fun)) '(a nil)))
+ )
+
+ ;; `progn' does not constitute a lexical scope for `defvar' (bug#46387).
+ (let ((fun '(lambda ()
+ (progn
+ (defvar bytecomp-tests--var1)
+ (defvar bytecomp-tests--var2))
+ (let ((bytecomp-tests--var1 'c)
+ (bytecomp-tests--var2 'd))
+ (bytecomp-tests--get-vars)))))
+ (should (listp fun))
+ (should (equal (funcall (eval fun t)) '(c d)))
+ (should (equal (funcall (byte-compile fun)) '(c d))))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el
b/test/lisp/emacs-lisp/cl-extra-tests.el
index f3c3087..91f0a1e 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
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/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index 065ca4f..a5ec62b 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index bcd63f7..2e5f302 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
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 a3010f9..9257f16 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -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 d60a6cb..dcb261c 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -219,16 +219,16 @@ index."
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq saved-local-map overriding-local-map)
(setq overriding-local-map edebug-tests-keymap)
- (add-hook 'post-command-hook 'edebug-tests-post-command))
+ (add-hook 'post-command-hook #'edebug-tests-post-command))
(advice-add 'exit-recursive-edit
- :around 'edebug-tests-preserve-keyboard-macro-state)
+ :around #'edebug-tests-preserve-keyboard-macro-state)
(unwind-protect
(kmacro-call-macro nil nil nil kbdmac)
(advice-remove 'exit-recursive-edit
- 'edebug-tests-preserve-keyboard-macro-state)
+ #'edebug-tests-preserve-keyboard-macro-state)
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq overriding-local-map saved-local-map)
- (remove-hook 'post-command-hook 'edebug-tests-post-command)))))
+ (remove-hook 'post-command-hook #'edebug-tests-post-command)))))
(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
"Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
@@ -857,12 +857,14 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-trivial-backquote ()
"Edebug can instrument a trivial backquote expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert "`1")
- (read-only-mode)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert "`1"))
(edebug-eval-defun nil)
- (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)")
+ ;; `eval-defun' outputs its message to the echo area in a rather
+ ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
+ ;; there in separate pieces (via `print' rather than via `message').
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
edebug-tests-messages))
(setq edebug-tests-messages "")
@@ -912,13 +914,17 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-cl-macrolet ()
"Edebug can instrument `cl-macrolet' expressions. (Bug#29919)"
(edebug-tests-with-normal-env
- (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)
+ (edebug-tests-locate-def "use-cl-macrolet")
(edebug-tests-run-kbd-macro
- "@ SPC SPC"
+ "C-u C-M-x SPC"
(edebug-tests-should-be-at "use-cl-macrolet" "func")
- (edebug-tests-should-match-result-in-messages "+")
- "g"
- (should (equal edebug-tests-@-result "The result of applying + to (1 x) is
11")))))
+ (edebug-tests-should-match-result-in-messages "+"))
+ (let ((edebug-initial-mode 'Go-nonstop))
+ (edebug-tests-setup-@ "use-cl-macrolet" '(10) t))
+ (edebug-tests-run-kbd-macro
+ "@ SPC g"
+ (should (equal edebug-tests-@-result "The result of applying + to (1 x) is
11"))
+ )))
(ert-deftest edebug-tests-backtrace-goto-source ()
"Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer."
@@ -951,8 +957,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 +1015,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/ert-tests.el
b/test/lisp/emacs-lisp/ert-tests.el
index 40cb432..bdacb08 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index f46fa63..9f40a18 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -7,18 +7,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el
b/test/lisp/emacs-lisp/lisp-mode-tests.el
index 85db3a0..e2cecdf 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/emacs-lisp/lisp-tests.el
b/test/lisp/emacs-lisp/lisp-tests.el
index fd07011..78ecf3f 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -8,6 +8,8 @@
;; Author: Marcin Borkowski <mbork@mbork.pl>
;; Keywords: internal
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
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/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 63d7c7b..12bf4f7 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -388,6 +388,8 @@
(ert-deftest rx-regexp ()
(should (equal (rx (regexp "abc") (regex "[de]"))
"\\(?:abc\\)[de]"))
+ (should (equal (rx "a" (regexp "$"))
+ "a\\(?:$\\)"))
(let ((x "a*"))
(should (equal (rx (regexp x) "b")
"\\(?:a*\\)b"))
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el
b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 5dbf227..7ced257 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/testcover-tests.el
b/test/lisp/emacs-lisp/testcover-tests.el
index 9f0312d..7854e33 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/gnus/gnus-search-tests.el
b/test/lisp/gnus/gnus-search-tests.el
index 63469f8..e30ed9a 100644
--- a/test/lisp/gnus/gnus-search-tests.el
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -5,18 +5,20 @@
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
;; Keywords:
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/gnus/gnus-util-tests.el
b/test/lisp/gnus/gnus-util-tests.el
index 7f64b96..959be79 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -3,12 +3,12 @@
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test/lisp/gnus/mm-decode-tests.el
b/test/lisp/gnus/mm-decode-tests.el
index 7d059cb..586097a 100644
--- a/test/lisp/gnus/mm-decode-tests.el
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -4,10 +4,10 @@
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index b7431870..a7ed7d3 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -1,14 +1,15 @@
;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*-
lexical-binding:t -*-
+
;; Copyright (C) 2015, 2020-2021 Free Software Foundation, Inc.
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index ea340c3..92306d1 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -244,7 +244,7 @@
:timeout 1)
;; Wait another 0.5 secs just in case the success handlers of
;; one of these last two requests didn't quite have a chance to
- ;; run (Emacs 25.2 apparentely needs this).
+ ;; run (Emacs 25.2 apparently needs this).
(accept-process-output nil 0.5)
(should second-deferred-went-through-p)
(should (eq 1 n-deferred-1))
diff --git a/test/lisp/mail/mail-utils-tests.el
b/test/lisp/mail/mail-utils-tests.el
new file mode 100644
index 0000000..5b54f24
--- /dev/null
+++ b/test/lisp/mail/mail-utils-tests.el
@@ -0,0 +1,104 @@
+;;; mail-utils-tests.el --- tests for mail-utils.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'sasl)
+(require 'mail-utils)
+
+(ert-deftest mail-utils-tests-mail-quote-printable ()
+ (should (equal (mail-quote-printable "abc") "abc"))
+ (should (equal (mail-quote-printable "åäö") "=E5=E4=F6"))
+ (should (equal (mail-quote-printable "åäö" t) "=?ISO-8859-1?Q?=E5=E4=F6?=")))
+
+(ert-deftest mail-utils-tests-mail-quote-printable-region ()
+ (with-temp-buffer
+ (insert "?=\"\"")
+ (mail-quote-printable-region (point-min) (point-max))
+ (should (equal (buffer-string) "=3F=3D=22=22")))
+ (with-temp-buffer
+ (insert "x")
+ (mail-quote-printable-region (point-min) (point-max) t)
+ (should (equal (buffer-string) "=?=?ISO-8859-1?Q?x"))))
+
+(ert-deftest mail-utils-tests-mail-unquote-printable ()
+ (should (equal (mail-unquote-printable "=E5=E4=F6") "åäö"))
+ (should (equal (mail-unquote-printable "=?ISO-8859-1?Q?=E5=E4=F6?=" t)
"åäö")))
+
+(ert-deftest mail-utils-tests-mail-unquote-printable-region ()
+ (with-temp-buffer
+ (insert "=E5=E4=F6")
+ (mail-unquote-printable-region (point-min) (point-max))
+ (should (equal (buffer-string) "åäö")))
+ (with-temp-buffer
+ (insert "=?ISO-8859-1?Q?=E5=E4=F6?=")
+ (mail-unquote-printable-region (point-min) (point-max) t)
+ (should (equal (buffer-string) "åäö"))))
+
+(ert-deftest mail-utils-tests-mail-strip-quoted-names ()
+ (should (equal (mail-strip-quoted-names
+ "\"foo\" <foo@example.org>, bar@example.org")
+ "foo@example.org, bar@example.org")))
+
+(ert-deftest mail-utils-tests-mail-dont-reply-to ()
+ (let ((mail-dont-reply-to-names "foo@example.org"))
+ (should (equal (mail-dont-reply-to "foo@example.org, bar@example.org")
+ "bar@example.org"))))
+
+
+(ert-deftest mail-utils-tests-mail-fetch-field ()
+ (with-temp-buffer
+ (insert "Foo: bar\nBaz: zut")
+ (should (equal (mail-fetch-field "Foo") "bar"))))
+
+(ert-deftest mail-utils-tests-mail-parse-comma-list ()
+ (with-temp-buffer
+ (insert "foo@example.org,bar@example.org,baz@example.org")
+ (goto-char (point-min))
+ (should (equal (mail-parse-comma-list)
+ '("baz@example.org" "bar@example.org" "foo@example.org")))))
+
+(ert-deftest mail-utils-tests-mail-comma-list-regexp ()
+ (should (equal (mail-comma-list-regexp
+ "foo@example.org,bar@example.org,baz@example.org")
+ "foo@example.org\\|bar@example.org\\|baz@example.org")))
+
+(ert-deftest mail-utils-tests-mail-rfc822-time-zone ()
+ (should (stringp (mail-rfc822-time-zone (current-time)))))
+
+(ert-deftest mail-utils-test-mail-rfc822-date/contains-year ()
+ (should (string-match (rx " 20" digit digit " ")
+ (mail-rfc822-date))))
+
+(ert-deftest mail-utils-test-mail-mbox-from ()
+ (with-temp-buffer
+ (insert "Subject: Hello
+From: jrh@example.org
+To: emacs-devel@gnu.org
+Date: Sun, 07 Feb 2021 22:46:37 -0500")
+ (should (equal (mail-mbox-from)
+ "From jrh@example.org Sun Feb 7 22:46:37 2021\n"))))
+
+(provide 'mail-utils-tests)
+;;; mail-utils-tests.el ends here
diff --git a/test/lisp/net/ntlm-resources/authinfo
b/test/lisp/net/ntlm-resources/authinfo
new file mode 100644
index 0000000..698391e
--- /dev/null
+++ b/test/lisp/net/ntlm-resources/authinfo
@@ -0,0 +1 @@
+machine localhost port http user ntlm password ntlm
diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el
index 6408ac1..2420b3b 100644
--- a/test/lisp/net/ntlm-tests.el
+++ b/test/lisp/net/ntlm-tests.el
@@ -17,11 +17,26 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; Run this with `NTLM_TESTS_VERBOSE=1' to get verbose debugging.
+
+;;; Code:
+
(require 'ert)
+(require 'ert-x)
(require 'ntlm)
+(defsubst ntlm-tests-message (format-string &rest arguments)
+ "Print a message conditional on an environment variable being set.
+FORMAT-STRING and ARGUMENTS are passed to the message function."
+ (when (getenv "NTLM_TESTS_VERBOSE")
+ (apply #'message (concat "ntlm-tests: " format-string) arguments)))
+
+
;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp',
;; for reference.
+
(defun ntlm-tests--time-to-timestamp (time)
"Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
@@ -49,4 +64,357 @@ signed integer. TIME must be on the form (HIGH LOW USEC
PSEC)."
(should (equal (ntlm--time-to-timestamp time)
(ntlm-tests--time-to-timestamp time)))))
+(defvar ntlm-tests--username-oem "ntlm"
+ "The username for NTLM authentication tests, in OEM string encoding.")
+(defvar ntlm-tests--username-unicode
+ (ntlm-ascii2unicode ntlm-tests--username-oem
+ (length ntlm-tests--username-oem))
+ "The username for NTLM authentication tests, in Unicode string encoding.")
+
+(defvar ntlm-tests--password "ntlm"
+ "The password used for NTLM authentication tests.")
+
+(defvar ntlm-tests--client-supports-unicode nil
+ "Non-nil if client supports Unicode strings.
+If client only supports OEM strings, nil.")
+
+(defvar ntlm-tests--challenge nil "The global random challenge.")
+
+(defun ntlm-server-build-type-2 ()
+ "Return an NTLM Type 2 message as a string.
+This string will be returned from the NTLM server to the NTLM client."
+ (let ((target (if ntlm-tests--client-supports-unicode
+ (ntlm-ascii2unicode "DOMAIN" (length "DOMAIN"))
+ "DOMAIN"))
+ (target-information ntlm-tests--password)
+ ;; Flag byte 1 flags.
+ (_negotiate-unicode 1)
+ (negotiate-oem 2)
+ (request-target 4)
+ ;; Flag byte 2 flags.
+ (negotiate-ntlm 2)
+ (_negotiate-local-call 4)
+ (_negotiate-always-sign 8)
+ ;; Flag byte 3 flags.
+ (_target-type-domain 1)
+ (_target-type-server 2)
+ (target-type-share 4)
+ (_negotiate-ntlm2-key 8)
+ (negotiate-target-information 128)
+ ;; Flag byte 4 flags, unused.
+ (_negotiate-128 32)
+ (_negotiate-56 128))
+ (concat
+ ;; Signature.
+ "NTLMSSP" (unibyte-string 0)
+ ;; Type 2.
+ (unibyte-string 2 0 0 0)
+ ;; Target length
+ (unibyte-string (length target) 0)
+ ;; Target allocated space.
+ (unibyte-string (length target) 0)
+ ;; Target offset.
+ (unibyte-string 48 0 0 0)
+ ;; Flags.
+ ;; Flag byte 1.
+ ;; Tell the client that this test server only supports OEM
+ ;; strings. This test server will handle Unicode strings
+ ;; anyway though.
+ (unibyte-string (logior negotiate-oem request-target))
+ ;; Flag byte 2.
+ (unibyte-string negotiate-ntlm)
+ ;; Flag byte 3.
+ (unibyte-string (logior negotiate-target-information target-type-share))
+ ;; Flag byte 4. Not sure what 2 means here.
+ (unibyte-string 2)
+ ;; Challenge. Set this to (unibyte-string 1 2 3 4 5 6 7 8)
+ ;; instead of (ntlm-generate-nonce) to hold constant for
+ ;; debugging.
+ (setq ntlm-tests--challenge (ntlm-generate-nonce))
+ ;; Context.
+ (make-string 8 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string 54 0 0 0)
+ target
+ target-information)))
+
+(defun ntlm-server-hash (challenge blob username password)
+ "Hash CHALLENGE, BLOB, USERNAME and PASSWORD for a Type 3 check."
+ (hmac-md5 (concat challenge blob)
+ (hmac-md5 (concat
+ (upcase
+ ;; This calculation always uses
+ ;; Unicode username, even when the
+ ;; server only supports OEM strings.
+ (ntlm-ascii2unicode username (length username))) "")
+ (cadr (ntlm-get-password-hashes password)))))
+
+(defun ntlm-server-check-authorization (authorization-string)
+ "Return t if AUTHORIZATION-STRING correctly authenticates the user."
+ (let* ((binary (base64-decode-string
+ (caddr (split-string authorization-string " "))))
+ (_lm-response-length (md4-unpack-int16 (substring binary 12 14)))
+ (_lm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 16 20))))
+ (ntlm-response-length (md4-unpack-int16 (substring binary 20 22)))
+ (ntlm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 24 28))))
+ (ntlm-hash
+ (substring binary ntlm-response-offset (+ ntlm-response-offset 16)))
+ (username-length (md4-unpack-int16 (substring binary 36 38)))
+ (username-offset (cdr (md4-unpack-int32 (substring binary 40 44))))
+ (username (substring binary username-offset
+ (+ username-offset username-length))))
+ (if (equal ntlm-response-length 24)
+ (let* ((expected
+ (ntlm-smb-owf-encrypt
+ (cadr (ntlm-get-password-hashes ntlm-tests--password))
+ ntlm-tests--challenge))
+ (received (substring binary ntlm-response-offset
+ (+ ntlm-response-offset
+ ntlm-response-length))))
+ (ntlm-tests-message "Got NTLMv1 response:")
+ (ntlm-tests-message "Expected hash: ===%S===" expected)
+ (ntlm-tests-message "Got hash: ===%S===" received)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (and (or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (equal expected received)))
+ (let* ((ntlm-response-blob
+ (substring binary (+ ntlm-response-offset 16)
+ (+ (+ ntlm-response-offset 16)
+ (- ntlm-response-length 16))))
+ (_ntlm-timestamp (substring ntlm-response-blob 8 16))
+ (_ntlm-nonce (substring ntlm-response-blob 16 24))
+ (_target-length (md4-unpack-int16 (substring binary 28 30)))
+ (_target-offset
+ (cdr (md4-unpack-int32 (substring binary 32 36))))
+ (_workstation-length (md4-unpack-int16 (substring binary 44 46)))
+ (_workstation-offset
+ (cdr (md4-unpack-int32 (substring binary 48 52)))))
+ (cond
+ ;; This test server claims to only support OEM strings,
+ ;; but also checks Unicode strings.
+ ((or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (let* ((password ntlm-tests--password)
+ (ntlm-hash-from-type-3 (ntlm-server-hash
+ ntlm-tests--challenge
+ ntlm-response-blob
+ ;; Always -oem since
+ ;; `ntlm-server-hash'
+ ;; always converts it to
+ ;; Unicode.
+ ntlm-tests--username-oem
+ password)))
+ (ntlm-tests-message "Got NTLMv2 response:")
+ (ntlm-tests-message "Expected hash: ==%S==" ntlm-hash)
+ (ntlm-tests-message "Got hash: ==%S==" ntlm-hash-from-type-3)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message " or username: ===%S==="
+ ntlm-tests--username-unicode)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (equal ntlm-hash ntlm-hash-from-type-3)))
+ (t
+ nil))))))
+
+(require 'eieio)
+(require 'cl-lib)
+
+;; Silence some byte-compiler warnings that occur when
+;; web-server/web-server.el is not found.
+(declare-function ws-send nil)
+(declare-function ws-parse-request nil)
+(declare-function ws-start nil)
+(declare-function ws-stop-all nil)
+
+(require 'web-server nil t)
+(require 'url-http-ntlm nil t)
+
+(defun ntlm-server-do-token (request _process)
+ "Process an NTLM client's REQUEST.
+PROCESS is unused."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (authorization-string (cdr authorization-header)))
+ (if (and (stringp authorization-string)
+ (string-match "NTLM " authorization-string))
+ (let* ((challenge (substring authorization-string (match-end 0)))
+ (binary (base64-decode-string challenge))
+ (type (aref binary 8))
+ ;; Flag byte 1 flags.
+ (negotiate-unicode 1)
+ (negotiate-oem 2)
+ (flags-byte-1 (aref binary 12))
+ (client-supports-unicode
+ (not (zerop (logand flags-byte-1 negotiate-unicode))))
+ (client-supports-oem
+ (not (zerop (logand flags-byte-1 negotiate-oem))))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (_keep-alive
+ (when connection-header (cdr connection-header)))
+ (response
+ (cl-case type
+ (1
+ ;; Return Type 2 message.
+ (when (and (not client-supports-unicode)
+ (not client-supports-oem))
+ (warn (concat
+ "Weird client supports neither Unicode"
+ " nor OEM strings, using OEM.")))
+ (setq ntlm-tests--client-supports-unicode
+ client-supports-unicode)
+ (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: NTLM "
+ (base64-encode-string
+ (ntlm-server-build-type-2) t) "\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n"))
+ (3
+ (if (ntlm-server-check-authorization
+ authorization-string)
+ "HTTP/1.1 200 OK\r\n\r\nAuthenticated.\r\n"
+ (progn
+ (if process
+ (set-process-filter process nil)
+ (error "Type 3 message found first?"))
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n")))))))
+ (if response
+ (ws-send process response)
+ (when process
+ (set-process-filter process nil)))
+ (when (equal type 3)
+ (set-process-filter process nil)
+ (process-send-eof process)))
+ (progn
+ ;; Did not get NTLM anything.
+ (set-process-filter process nil)
+ (process-send-eof process)
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n"))))))
+
+(defun ntlm-server-filter (process string)
+ "Read from PROCESS a STRING and treat it as a request from an NTLM client."
+ (let ((request (make-instance 'ws-request
+ :process process :pending string)))
+ (if (ws-parse-request request)
+ (ntlm-server-do-token request process)
+ (error "Failed to parse request"))))
+
+(defun ntlm-server-handler (request)
+ "Handle an HTTP REQUEST."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (keep-alive (when connection-header (cdr connection-header)))
+ (response (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: NTLM\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n")))
+ (if (null authorization-header)
+ ;; Tell client to use NTLM. Firefox will create a new
+ ;; connection.
+ (progn
+ (process-send-string process response)
+ (process-send-eof process))
+ (progn
+ (ntlm-server-do-token request nil)
+ (set-process-filter process #'ntlm-server-filter)
+ (if (equal (upcase keep-alive) "KEEP-ALIVE")
+ :keep-alive
+ (error "NTLM server expects keep-alive connection header")))))))
+
+(defun ntlm-server-start ()
+ "Start an NTLM server on port 8080 for testing."
+ (ws-start 'ntlm-server-handler 8080))
+
+(defun ntlm-server-stop ()
+ "Stop the NTLM server."
+ (ws-stop-all))
+
+(defvar ntlm-tests--result-buffer nil "Final NTLM result buffer.")
+
+(require 'url)
+
+(defun ntlm-tests--url-retrieve-internal-around (original &rest arguments)
+ "Save the result buffer from a `url-retrieve-internal' to a global variable.
+ORIGINAL is the original `url-retrieve-internal' function and
+ARGUMENTS are passed to it."
+ (setq ntlm-tests--result-buffer (apply original arguments)))
+
+(defun ntlm-tests--authenticate ()
+ "Authenticate using credentials from the authinfo resource file."
+ (setq ntlm-tests--result-buffer nil)
+ (let ((auth-sources (list (ert-resource-file "authinfo")))
+ (auth-source-do-cache nil)
+ (auth-source-debug (when (getenv "NTLM_TESTS_VERBOSE") 'trivia)))
+ (ntlm-tests-message "Using auth-sources: %S" auth-sources)
+ (url-retrieve-synchronously "http://localhost:8080";))
+ (sleep-for 0.1)
+ (ntlm-tests-message "Results are in: %S" ntlm-tests--result-buffer)
+ (with-current-buffer ntlm-tests--result-buffer
+ (buffer-string)))
+
+(defun ntlm-tests--start-server-authenticate-stop-server ()
+ "Start an NTLM server, authenticate against it, then stop the server."
+ (advice-add #'url-retrieve-internal
+ :around #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ (ntlm-server-start)
+ (let ((result (ntlm-tests--authenticate)))
+ (advice-remove #'url-retrieve-internal
+ #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ result))
+
+(defvar ntlm-tests--successful-result
+ (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n")
+ "Expected result of successful NTLM authentication.")
+
+(require 'find-func)
+(defun ntlm-tests--ensure-ws-parse-ntlm-support ()
+ "Ensure NTLM special-case in `ws-parse'."
+ (let* ((hit (find-function-search-for-symbol
+ 'ws-parse nil (locate-file "web-server.el" load-path)))
+ (buffer (car hit))
+ (position (cdr hit)))
+ (with-current-buffer buffer
+ (goto-char position)
+ (search-forward-regexp
+ ":NTLM" (save-excursion (forward-sexp) (point)) t))))
+
+(require 'lisp-mnt)
+(defvar ntlm-tests--dependencies-present
+ (and (featurep 'url-http-ntlm)
+ (version<= "2.0.4"
+ (lm-version (locate-file "url-http-ntlm.el" load-path)))
+ (featurep 'web-server)
+ (ntlm-tests--ensure-ws-parse-ntlm-support))
+ "Non-nil if GNU ELPA test dependencies were loaded.")
+
+(ert-deftest ntlm-authentication ()
+ "Check ntlm.el's implementation of NTLM authentication over HTTP."
+ (skip-unless ntlm-tests--dependencies-present)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
+(ert-deftest ntlm-authentication-old-compatibility-level ()
+ (skip-unless ntlm-tests--dependencies-present)
+ (setq ntlm-compatibility-level 0)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
(provide 'ntlm-tests)
+
+;;; ntlm-tests.el ends here
diff --git a/test/lisp/net/sasl-scram-rfc-tests.el
b/test/lisp/net/sasl-scram-rfc-tests.el
index 3e9879a..dfd4cf0 100644
--- a/test/lisp/net/sasl-scram-rfc-tests.el
+++ b/test/lisp/net/sasl-scram-rfc-tests.el
@@ -4,6 +4,8 @@
;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f488392..016b4d3 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',
@@ -5092,8 +5102,10 @@ INPUT, if non-nil, is a string sent to the process."
(string-match-p
(regexp-quote envvar)
;; We must remove PS1, the output is truncated otherwise.
+ ;; We must suppress "_=VAR...".
(funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ this-shell-command-to-string
+ "printenv | grep -v PS1 | grep -v _=")))))))))
(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
"Check that remote processes set / unset environment variables properly.
@@ -6730,8 +6742,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/nxml/nxml-mode-tests.el
b/test/lisp/nxml/nxml-mode-tests.el
index 4baab1f..7824691 100644
--- a/test/lisp/nxml/nxml-mode-tests.el
+++ b/test/lisp/nxml/nxml-mode-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/nxml/xsd-regexp-tests.el
b/test/lisp/nxml/xsd-regexp-tests.el
index 4dbc899..2194602 100644
--- a/test/lisp/nxml/xsd-regexp-tests.el
+++ b/test/lisp/nxml/xsd-regexp-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el
index 4a5f4f8..0e02e1c 100644
--- a/test/lisp/obsolete/cl-tests.el
+++ b/test/lisp/obsolete/cl-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/play/cookie1-resources/cookies
b/test/lisp/play/cookie1-resources/cookies
new file mode 100644
index 0000000..7bf569f
--- /dev/null
+++ b/test/lisp/play/cookie1-resources/cookies
@@ -0,0 +1,8 @@
+This fortune intentionally left blank.
+%
+This fortune intentionally not included.
+%
+This fortune intentionally says nothing.
+%
+This fortune is false.
+%
diff --git a/test/lisp/play/cookie1-tests.el b/test/lisp/play/cookie1-tests.el
new file mode 100644
index 0000000..d63ecb9
--- /dev/null
+++ b/test/lisp/play/cookie1-tests.el
@@ -0,0 +1,40 @@
+;;; fortune-tests.el --- Tests for fortune.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'cookie1)
+
+(ert-deftest cookie1-tests-cookie ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (cookie fortune-file)))))
+
+(ert-deftest cookie1-testss-cookie-apropos ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (car (cookie-apropos "false" fortune-file))))
+ (should (= (length (cookie-apropos "false" fortune-file)) 1))))
+
+(provide 'fortune-tests)
+;;; fortune-tests.el ends here
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/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index cf1ed28..e55eb6d 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -74,7 +74,6 @@
;; From bug#44834
(ert-deftest tcl-mode-namespace-indent-2 ()
- :expected-result :failed
(with-temp-buffer
(tcl-mode)
(let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar
{}{}}\n"))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 7b02281..f2ddc2e 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -48,6 +48,31 @@
(should (= (count-words (point-min) (point-max)) 10))))
+;;; `count-lines'
+
+(ert-deftest simple-test-count-lines ()
+ (with-temp-buffer
+ (should (= (count-lines (point-min) (point-max)) 0))
+ (insert "foo")
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (insert "\nbar\nbaz\n")
+ (should (= (count-lines (point-min) (point-max)) 3))
+ (insert "r\n")
+ (should (= (count-lines (point-min) (point-max)) 4))))
+
+(ert-deftest simple-test-count-lines/ignore-invisible-lines ()
+ (with-temp-buffer
+ (insert "foo\nbar")
+ (should (= (count-lines (point-min) (point-max) t) 2))
+ (insert (propertize "\nbar\nbaz\nzut" 'invisible t))
+ (should (= (count-lines (point-min) (point-max) t) 2))))
+
+(ert-deftest simple-text-count-lines-non-ascii ()
+ (with-temp-buffer
+ (insert "あ\nい\nう\nえ\nお\n")
+ (should (= (count-lines (point) (point)) 0))))
+
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
diff --git a/test/lisp/textmodes/dns-mode-tests.el
b/test/lisp/textmodes/dns-mode-tests.el
index 694d683..8bc4873 100644
--- a/test/lisp/textmodes/dns-mode-tests.el
+++ b/test/lisp/textmodes/dns-mode-tests.el
@@ -25,6 +25,27 @@
(require 'ert)
(require 'dns-mode)
+(ert-deftest dns-mode-tests-dns-mode-soa-increment-serial ()
+ (with-temp-buffer
+ (insert "$TTL 86400
+@ IN SOA ns.icann.org. noc.dns.icann.org. (
+ 2015080302 ;Serial
+ 7200 ;Refresh
+ 3600 ;Retry
+ 1209600 ;Expire
+ 3600 ;Negative response caching TTL\n)")
+ (dns-mode-soa-increment-serial)
+ ;; Number is updated from 2015080302 to the current date
+ ;; (actually, just ensure the year part is later than 2020).
+ (should (string-match "\\$TTL 86400
+@ IN SOA ns.icann.org. noc.dns.icann.org. (
+ 20[2-9][0-9]+ ;Serial
+ 7200 ;Refresh
+ 3600 ;Retry
+ 1209600 ;Expire
+ 3600 ;Negative response caching TTL\n)"
+ (buffer-string)))))
+
;;; IPv6 reverse zones
(ert-deftest dns-mode-ipv6-conversion ()
(let ((address "2001:db8::42"))
diff --git a/test/manual/cedet/cedet-utests.el
b/test/manual/cedet/cedet-utests.el
index 7805fce..e421054 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -26,7 +26,6 @@
;; into one command.
(require 'cedet)
-(require 'inversion)
(defvar cedet-utest-directory
(let* ((C (file-name-directory (locate-library "cedet")))
@@ -36,7 +35,6 @@
(defvar cedet-utest-libs '("ede-tests"
"semantic-tests"
- "srecode-tests"
)
"List of test srcs that need to be loaded.")
@@ -48,7 +46,7 @@
;;
;; Test inversion
- ("inversion" . inversion-unit-test)
+ ;; ("inversion" . inversion-unit-test) ; moved to automated suite
;; EZ Image dumping.
("ezimage associations" . ezimage-image-association-dump)
@@ -60,7 +58,7 @@
("pulse interactive test" . (lambda () (pulse-test t)))
;; Files
- ("cedet file conversion" . cedet-files-utest)
+ ;; ("cedet file conversion" . cedet-files-utest) ; moved to automated suite
;;
;; EIEIO
@@ -100,14 +98,14 @@
(message " ** Skipping test in noninteractive mode.")
(semantic-test-throw-on-input))))
- ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
+ ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
; moved to automated suite
;;
;; SRECODE
;;
;; TODO - fix the fields test
- ;;("srecode: fields" . srecode-field-utest)
+ ;;("srecode: fields" . srecode-field-utest) ; moved to automated suite
;;("srecode: templates" . srecode-utest-template-output)
("srecode: show maps" . srecode-get-maps)
;;("srecode: getset" . srecode-utest-getset-output)
@@ -376,7 +374,7 @@ Optional argument PRECR indicates to prefix the done msg w/
a newline."
(cedet-utest-add-log-item-start testname)
))
-(defun cedet-utest-log(format &rest args)
+(defun cedet-utest-log (format &rest args)
"Log the text string FORMAT.
The rest of the ARGS are used to fill in FORMAT with `format'."
(if noninteractive
@@ -392,99 +390,6 @@ The rest of the ARGS are used to fill in FORMAT with
`format'."
(cedet-utest-show-log-end)
)
-;;; Inversion tests
-
-(defun inversion-unit-test ()
- "Test inversion to make sure it can identify different version strings."
- (interactive)
- (let ((c1 (inversion-package-version 'inversion))
- (c1i (inversion-package-incompatibility-version 'inversion))
- (c2 (inversion-decode-version "1.3alpha2"))
- (c3 (inversion-decode-version "1.3beta4"))
- (c4 (inversion-decode-version "1.3 beta5"))
- (c5 (inversion-decode-version "1.3.4"))
- (c6 (inversion-decode-version "2.3alpha"))
- (c7 (inversion-decode-version "1.3"))
- (c8 (inversion-decode-version "1.3pre1"))
- (c9 (inversion-decode-version "2.4 (patch 2)"))
- (c10 (inversion-decode-version "2.4 (patch 3)"))
- (c11 (inversion-decode-version "2.4.2.1"))
- (c12 (inversion-decode-version "2.4.2.2"))
- )
- (if (not (and
- (inversion-= c1 c1)
- (inversion-< c1i c1)
- (inversion-< c2 c3)
- (inversion-< c3 c4)
- (inversion-< c4 c5)
- (inversion-< c5 c6)
- (inversion-< c2 c4)
- (inversion-< c2 c5)
- (inversion-< c2 c6)
- (inversion-< c3 c5)
- (inversion-< c3 c6)
- (inversion-< c7 c6)
- (inversion-< c4 c7)
- (inversion-< c2 c7)
- (inversion-< c8 c6)
- (inversion-< c8 c7)
- (inversion-< c4 c8)
- (inversion-< c2 c8)
- (inversion-< c9 c10)
- (inversion-< c10 c11)
- (inversion-< c11 c12)
- ;; Negatives
- (not (inversion-< c3 c2))
- (not (inversion-< c4 c3))
- (not (inversion-< c5 c4))
- (not (inversion-< c6 c5))
- (not (inversion-< c7 c2))
- (not (inversion-< c7 c8))
- (not (inversion-< c12 c11))
- ;; Test the tester on inversion
- (not (inversion-test 'inversion inversion-version))
- ;; Test that we throw an error
- (inversion-test 'inversion "0.0.0")
- (inversion-test 'inversion "1000.0")
- ))
- (error "Inversion tests failed")
- (message "Inversion tests passed."))))
-
-;;; cedet-files unit test
-
-(defvar cedet-files-utest-list
- '(
- ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
- ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
- ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
- ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
- )
- "List of different file names to test.
-Each entry is a cons cell of ( FNAME . CONVERTED )
-where FNAME is some file name, and CONVERTED is what it should be
-converted into.")
-
-(defun cedet-files-utest ()
- "Test out some file name conversions."
- (interactive)
- (let ((idx 0))
- (dolist (FT cedet-files-utest-list)
-
- (setq idx (+ idx 1))
-
- (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
- (file->dir (cedet-file-name-to-directory-name (cdr FT) t))
- )
-
- (unless (string= (cdr FT) dir->file)
- (error "Failed: %d. Found: %S Wanted: %S"
- idx dir->file (cdr FT))
- )
-
- (unless (string= file->dir (car FT))
- (error "Failed: %d. Found: %S Wanted: %S"
- idx file->dir (car FT)))))))
-
;;; pulse test
(defun pulse-test (&optional no-error)
diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el
index eb31323..2af5086 100644
--- a/test/manual/cedet/ede-tests.el
+++ b/test/manual/cedet/ede-tests.el
@@ -1,4 +1,4 @@
-;;; ede-tests.el --- Some tests for the Emacs Development Environment
+;;; ede-tests.el --- Some tests for the Emacs Development Environment -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -42,8 +42,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-global (file)
"Test EDE Locate on FILE using GNU Global type.
@@ -55,8 +54,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-idutils (file)
"Test EDE Locate on FILE using ID Utils type.
@@ -68,8 +66,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-cscope (file)
"Test EDE Locate on FILE using CScope type.
@@ -81,7 +78,6 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
;;; ede-test.el ends here
diff --git a/test/manual/cedet/semantic-tests.el
b/test/manual/cedet/semantic-tests.el
index 716bcc7..3d72fa2 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -138,21 +138,6 @@ Optional argument ARG specifies not to use color."
(require 'semantic/fw)
-(defun semantic-test-data-cache ()
- "Test the data cache."
- (interactive)
- (let ((data '(a b c)))
- (save-excursion
- (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
- (erase-buffer)
- (insert "The Moose is Loose")
- (goto-char (point-min))
- (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
- data 'moose 'exit-cache-zone)
- (if (equal (semantic-get-cache-data 'moose) data)
- (message "Successfully retrieved cached data.")
- (error "Failed to retrieve cached data")))))
-
(defun semantic-test-throw-on-input ()
"Test that throw on input will work."
(interactive)
@@ -281,110 +266,3 @@ tag that contains point, and return that."
Lcount (semantic-tag-name target)
(semantic-elapsed-time start nil)))
Lcount)))
-
-;;; From bovine-gcc:
-
-(require 'semantic/bovine/gcc)
-
-;; Example output of "gcc -v"
-(defvar semantic-gcc-test-strings
- '(;; My old box:
- "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--host=i386-redhat-linux
-Thread model: posix
-gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
- ;; Alex Ott:
- "Using built-in specs.
-Target: i486-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1'
--with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-chec [...]
-Thread model: posix
-gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
- ;; My debian box:
- "Using built-in specs.
-Target: x86_64-unknown-linux-gnu
-Configured with: ../../../sources/gcc/configure
--prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3
--with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr
--enable-languages=c,c++,fortran
--with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as
--with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
-Thread model: posix
-gcc version 4.2.3"
- ;; My mac:
- "Using built-in specs.
-Target: i686-apple-darwin8
-Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure
--disable-checking -enable-werror --prefix=/usr --mandir=/share/man
--enable-languages=c,objc,c++,obj-c++
--program-transform-name=/^[cg][^.-]*$/s/$/-4.0/
--with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib
--build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott
--program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
-Thread model: posix
-gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
- ;; Ubuntu Intrepid
- "Using built-in specs.
-Target: x86_64-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-checking=release --build [...]
-Thread model: posix
-gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Red Hat EL4
- "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
-Thread model: posix
-gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
- ;; Red Hat EL5
- "Using built-in specs.
-Target: x86_64-redhat-linux
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--enable-checking=release --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-libgcj-multifile
--enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk
--disable-dssi --enable-plugin
--with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic
--host=x86_64-redhat-linux
-Thread model: posix
-gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
- ;; David Engster's german gcc on ubuntu 4.3
- "Es werden eingebaute Spezifikationen verwendet.
-Ziel: i486-linux-gnu
-Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-ch [...]
-Thread-Modell: posix
-gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Damien Deville bsd
- "Using built-in specs.
-Target: i386-undermydesk-freebsd
-Configured with: FreeBSD/i386 system compiler
-Thread model: posix
-gcc version 4.2.1 20070719 [FreeBSD]"
- )
- "A bunch of sample gcc -v outputs from different machines.")
-
-(defvar semantic-gcc-test-strings-fail
- '(;; A really old solaris box I found
- "Reading specs from
/usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
-gcc version 2.95.2 19991024 (release)"
- )
- "A bunch of sample gcc -v outputs that fail to provide the info we want.")
-
-(defun semantic-gcc-test-output-parser ()
- "Test the output parser against some collected strings."
- (interactive)
- (let ((fail nil))
- (dolist (S semantic-gcc-test-strings)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc 'target fields))
- (cdr (assoc '--target fields))
- (cdr (assoc '--host fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- ;; No longer test for prefixes.
- (when (not (and v h))
- (let ((strs (split-string S "\n")))
- (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
- (setq fail t))
- ))
- (dolist (S semantic-gcc-test-strings-fail)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc '--host fields))
- (cdr (assoc 'target fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- (when (and v h p)
- (message "Negative test failed on %S" S)
- (setq fail t))
- ))
- (if (not fail) (message "Tests passed."))
- ))
-
-(defun semantic-gcc-test-output-parser-this-machine ()
- "Test the output parser against the machine currently running Emacs."
- (interactive)
- (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
- (semantic-gcc-test-output-parser))
- )
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index 3bc945d..a54c253 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -1,4 +1,4 @@
-;;; test.el --- Unit test file for Semantic Emacs Lisp support.
+;;; test.el --- Unit test file for Semantic Emacs Lisp support. -*-
lexical-binding: t -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 3de1551..e6b060f 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -2143,11 +2143,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1035
diff --git a/test/manual/etags/el-src/TAGTEST.EL
b/test/manual/etags/el-src/TAGTEST.EL
index 89a6791..3e6599a 100644
--- a/test/manual/etags/el-src/TAGTEST.EL
+++ b/test/manual/etags/el-src/TAGTEST.EL
@@ -1,3 +1,5 @@
+;;; -*- lexical-binding: t -*-
+
(foo::defmumble bletch beuarghh)
(defun foo==bar () (message "hi")) ; Bug#5624
;;; Ctags test file for lisp mode.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index e0aed2a..9f6593a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1098,3 +1098,11 @@
(goto-char (point-max))
(insert "fóo")
(should (approx-equal (buffer-line-statistics) '(1002 50 49.9)))))
+
+(ert-deftest test-line-number-at-position ()
+ (with-temp-buffer
+ (insert (make-string 10 ?\n))
+ (should (= (line-number-at-pos (point)) 11))
+ (should (= (line-number-at-pos nil) 11))
+ (should-error (line-number-at-pos -1))
+ (should-error (line-number-at-pos 100))))
diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el
index 10f1202..6a3f1a5 100644
--- a/test/src/indent-tests.el
+++ b/test/src/indent-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; 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.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
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)))
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 607d2ea..41c8cdd 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -23,14 +23,15 @@
(ert-deftest keyboard-unread-command-events ()
"Test `unread-command-events'."
- (should (equal (progn (push ?\C-a unread-command-events)
- (read-event nil nil 1))
- ?\C-a))
- (should (equal (progn (run-with-timer
- 1 nil
- (lambda () (push '(t . ?\C-b) unread-command-events)))
- (read-event nil nil 2))
- ?\C-b)))
+ (let ((unread-command-events nil))
+ (should (equal (progn (push ?\C-a unread-command-events)
+ (read-event nil nil 1))
+ ?\C-a))
+ (should (equal (progn (run-with-timer
+ 1 nil
+ (lambda () (push '(t . ?\C-b)
unread-command-events)))
+ (read-event nil nil 2))
+ ?\C-b))))
(ert-deftest keyboard-lossage-size ()
"Test `lossage-size'."
@@ -46,6 +47,28 @@
(should-error (lossage-size (1- min-value)))
(should (= lossage-orig (lossage-size lossage-orig)))))
+;; FIXME: This test doesn't currently work :-(
+;; (ert-deftest keyboard-tests--echo-keystrokes-bug15332 ()
+;; (let ((msgs '())
+;; (unread-command-events nil)
+;; (redisplay--interactive t)
+;; (echo-keystrokes 2))
+;; (setq unread-command-events '(?\C-u))
+;; (let* ((timer1
+;; (run-with-timer 3 1
+;; (lambda ()
+;; (setq unread-command-events '(?5)))))
+;; (timer2
+;; (run-with-timer 2.5 1
+;; (lambda ()
+;; (push (current-message) msgs)))))
+;; (run-with-timer 5 nil
+;; (lambda ()
+;; (cancel-timer timer1)
+;; (cancel-timer timer2)
+;; (throw 'exit msgs)))
+;; (recursive-edit)
+;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-"))))))
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index a3fba8d..e62bcb3 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -879,5 +879,33 @@ Return nil if FILENAME doesn't exist."
(file-regular-p filename)
filename)))
+;; Bug#46284
+(ert-deftest process-sentinel-interrupt-event ()
+ "Test that interrupting a process on Windows sends \"interrupt\" to
sentinel."
+ (skip-unless (eq system-type 'windows-nt))
+ (with-temp-buffer
+ (let* ((proc-buf (current-buffer))
+ ;; Start a new emacs process to wait idly until interrupted.
+ (cmd "emacs -batch --eval=\"(sit-for 50000)\"")
+ (proc (start-file-process-shell-command
+ "test/process-sentinel-signal-event" proc-buf cmd))
+ (events '()))
+
+ ;; Capture any incoming events.
+ (set-process-sentinel proc
+ (lambda (_prc event)
+ (push event events)))
+ ;; Wait for the process to start.
+ (sleep-for 2)
+ (should (equal 'run (process-status proc)))
+ ;; Interrupt the sub-process and wait for it to die.
+ (interrupt-process proc)
+ (sleep-for 2)
+ ;; Should have received SIGINT...
+ (should (equal 'signal (process-status proc)))
+ (should (equal 2 (process-exit-status proc)))
+ ;; ...and the change description should be "interrupt".
+ (should (equal '("interrupt\n") events)))))
+
(provide 'process-tests)
;;; process-tests.el ends here